Detach Images Not Found

[jlaidle1]

Anyone have a LISP routine that will detach any images that are not found?

Thanks in advance. 

[dlanorh · Accepted solution]

Try this if suitable. The images still show up in external references until the drawing is saved and reloaded.

;; Jeff Mishler? 4/23/03
;; Routine deletes images not found in support paths or no longer exist at path location
;; Removes reference to unreferenced images and drawings where the image had been deleted
;; but was still referenced in the image dictionary.

(defun c:rui ( / ss cnt i_dict s_lst e_lst d_ent d_obj i_path indx i_tst len tmp)
  (vl-load-com)
  (defun massoc (key alist / x nlist)
    (foreach x alist (if (eq key (car x)) (setq nlist (cons (cdr x) nlist))))
    (reverse nlist)
  );end_defun

  (defun remlst (/ tmp1)
    (setq tmp (length (member (cdr (assoc 340 (entget d_ent))) e_lst)))
    (repeat (- (length s_lst) tmp)
      (setq tmp1 (cons (car s_lst) tmp1))
      (setq s_lst (cdr s_lst))
    );end_repeat
    (setq tmp (list (car s_lst)))
    (setq s_lst (append (reverse tmp1) (cdr s_lst)))
  );end_defun

  (setq ss (ssget "x" '((0 . "IMAGE")))
        cnt 0
        len 0
        i_dict (dictsearch (namedobjdict) "acad_image_dict")
        s_lst (massoc 3 i_dict)
        e_lst (massoc 350 i_dict)
  );end_setq
  (cond (ss
          (setq len (sslength ss))
          (while (< cnt (sslength ss))
            (setq d_ent (ssname ss cnt)
                  d_obj (vlax-ename->vla-object d_ent)
                  i_path (vla-get-ImageFile d_obj)
                  indx (- (strlen i_path) 5)
                  i_tst (substr i_path indx (1+ (- (strlen i_path) indx)))
            );end_setq
            (remlst)
            (while (and (/= T (wcmatch i_tst "\\*")) (not (zerop (1- indx))))
              (setq iname i_tst
                    indx (1- indx)
                    i_tst (substr i_path indx (1+ (strlen iname)))
              );end_setq
            );end_while
            (cond ( (and (not (findfile i_path)) (not (findfile iname)))
                    (dictremove (cdr (car i_dict)) (car tmp))
                    (append tmp s_lst)
                    (ssdel d_ent ss)
                    (entdel d_ent)
                  )
                  (t (setq cnt (1+ cnt)))
            );end_cond
          );end_while
          (setq tmp (length s_lst))
          (while s_lst
            (dictremove (cdr (car i_dict)) (car s_lst))
            (setq s_lst (cdr s_lst))
          );end_while
      )
      (t (setq tmp (length s_lst))
         (while s_lst
           (dictremove (cdr (car i_dict)) (car s_lst))
           (setq s_lst (cdr s_lst))
          );end_while
      )
  );end_cond
  (alert (strcat "\nImages Found : " (itoa len) "\n\nRemoved " (itoa tmp) " unreferenced images"))
);end_defun

[ronjonp]

Quick Google search and there is THIS too.

[scot-65]

This bit of code will only removed unreferenced images in the drawing file

and not in any other "attached" files - xref or otherwise.

 
 ;*** REMOVE UNREFERENCED IMAGES *** 5-5-07
 ; Erasing images does not unload images from file.
 (defun QSAVE_IMAGE ( / a b c n n1 s )
  (if (and (setq a (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))
           (assoc 350 a) );and
   (progn
    (setq b nil)
    (if (setq s (ssget "X" (list (cons 0 "IMAGE"))))
     (progn
      (setq n 0)
      (repeat (sslength s)
     	 (setq b (cons (cdr (assoc 340 (entget (ssname s n)))) b) n (1+ n))
      );repeat
     );progn
    );if
    (setq n nil)
    (while (setq n (tblnext "BLOCK" (not n)))
     (setq s (cdr (assoc -2 n)))
     (while s
      (if (= (cdr (assoc 0 (setq c (entget s)))) "IMAGE")
       (setq b (cons (cdr (assoc 340 c)) b)) );if
      (setq s (entnext s))
     );while
    );while
    (setq n1 0)
    (foreach x a
     (if (and (= (car x) 350) (not (member (cdr x) b)))
      (progn (entdel (cdr x)) (setq n1 (1+ n1)) ));if
    );foreach
    (if (> n1 0) (princ "\n Removing Unreferenced Image(s)."))
   );progn
  );if
  (setq a nil b nil c nil n nil n1 nil s nil)
 );endQSAVE_IMAGE
 

???

[john.uhden]

I love it... flashback to the old days with John Laidler and Jeff Mishler, both very good guys.

Thanks, Ronald, for finding that.

[jlaidle1]

There are a lot of those good old days!!  lol

[andersonreyesortiz]

Hello Scot, what is the command for running this lisp after load it?

Thanks a lot!!!

[ronjonp]

@andersonreyesortiz 

Change this:

(defun QSAVE_IMAGE

To this:

(defun C:QSAVE_IMAGE

The call QSAVE_IMAGE