Friday, June 26, 2009

Purge unreferenced images in AutoCAD with AutoLISP

Here is some AutoLISP code that can be used to purge unreferenced images from a drawing and delete and detach all images that are not found.

It is prepared to be used together with SmartPurger so multiple drawings can be processed.

An unreferenced image is attached to the drawing but have been erased. A Not Found image is no longer existing in the valid search paths. An Unresolved image cannot be read by AutoCAD.

(defun purge-unreferenced-images (/ ss1 ctr id symlst enamelst delent vl_delent ipath iname tmp)
 (defun remlst (/ tmp1)
  (setq
    tmp (length (member (cdr (assoc 340 (entget delent))) enamelst))
  )
  (repeat (- (length symlst) tmp)
    (setq tmp1 (cons (car symlst) tmp1))
    (setq symlst (cdr symlst))
  )
  (setq tmp (list (car symlst)))
  (setq symlst (append (reverse tmp1) (cdr symlst)))
 )
 (defun massoc (key alist / x nlist)
  (foreach x alist
    (if (eq key (car x))
      (setq nlist (cons (cdr x) nlist))
    )
  )
  (reverse nlist)
 )

  (vl-load-com) 
  (setq ss1 (ssget "x" '((0 . "IMAGE"))))
  (setq ctr 0)
  (setq id (dictsearch (namedobjdict) "acad_image_dict"))
  (setq symlst (massoc 3 id))
  (setq enamelst (massoc 350 id))
  (if ss1
    (progn
      (while (< ctr (sslength ss1))
 (setq delent (ssname ss1 ctr))
 (setq vl_delent (vlax-ename->vla-object delent))
 (setq ipath (vla-get-ImageFile vl_delent))
 (remlst)

 (setq iname (strcat (vl-filename-base ipath) (vl-filename-extension ipath)))

 (if (and (not (findfile ipath))
   (not (findfile iname))
     )
   (progn
     (dictremove (cdr (car id)) (car tmp))
     (append tmp symlst)
     (ssdel delent ss1)
     (vla-delete vl_delent)
   )
   (progn
     (setq ctr (1+ ctr))
   )
 )
      )
    )
  )
  (while symlst
    (dictremove (cdr (car id)) (car symlst))
    (setq symlst (cdr symlst))
  )
)
(purge-unreferenced-images)
(command "QSAVE")
(command "_QUIT")

Some of the latest blog posts

Subscribe to RSS headline updates from:
Powered by FeedBurner