Image Clipper

(defun c:icp (/ image object fuzz i l len p lst pts)
    (vl-load-com)
    (if
 (and
     (setq image (car (entsel "\nSelect RasterImage:")))
     (setq Object (car (entsel "\nSelect Clipping Object:")))
 )
    (progn
        (setq l   nil
       fuzz 0.1
       i   fuzz
        )
        (cond
     ((eq (cdr (assoc 0 (entget object))) "CIRCLE")
      (setq len (vlax-get (vlax-ename->vla-object object)
     'circumference
         )
      )
      (repeat (fix (/ len fuzz))
   (setq p (vlax-curve-getpointatdist object fuzz))
   (setq l (cons (list (car p) (cadr p)) l))
   (setq fuzz (+ i fuzz))
      )
      (setq lst (apply 'append (reverse l)))
      (vla-put-ClippingEnabled
   (vlax-ename->vla-object image)
   :vlax-true
      )
      (vla-clipboundary
   (vlax-ename->vla-object image)
   (gs:Safearray lst)
      )
      (vla-delete (vlax-ename->vla-object object))
     )
     ((eq (cdr (assoc 0 (entget object))) "LWPOLYLINE")
      (vla-put-ClippingEnabled
   (vlax-ename->vla-object image)
   :vlax-true
      )
      (setq pts (vlax-safearray->list
      (vlax-variant-value
          (vla-get-coordinates
       (vlax-ename->vla-object object)
          )
      )
         )
      )
      (vla-clipboundary
   (vlax-ename->vla-object image)
   (gs:Safearray pts)
      )
      (vla-delete (vlax-ename->vla-object object))
     )
        )
    )
    )
    (princ)
)
(defun gs:Safearray (points / arrayspace)
    (setq arrayspace
      (vlax-make-safearray
   vlax-vbdouble
   (cons 0 (1+ (length points)))
      )
    )
    (vlax-safearray-fill
 arrayspace
 (append points (list (car points) (cadr points)))
    )
)