[编程交流] Purging x-references

; (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)