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. Download the code here, extract the zip file and rename the file from having file extension .txt to .scr and load it with SmartPurger in options>settings>general>script/lisp file.

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")

1 comment:

  1. AnonymousJuly 30, 2009

    Good but i'm not sure if this works 100% so beware before running on a batch of drawings

    I have a test drawing with 2 images, 1 within a block and one regularly attached.

    This script actually deletes the image contained in the block.

    Just make sure you test first....

    Cheers

    Jamie

    ReplyDelete