[编程交流] 脚本文件

; (purge-unreferenced-images)
(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))
 )
)
(defun c:PUI()
 (purge-unreferenced-images)
 (princ)
)
(princ)

_.open *file* (load "purge-unreferenced-images.lsp" nil) (if purge-unreferenced-images (purge-unreferenced-images)) _.qsave _.close