LISP to Remove Unreferenced Xref

[MAzri]

My mind going crazy over this. All code iteration i tried could not find the unreferenced xrefs and thus it could not process to detach it. even simple -xref, D, * could not find any xref. Is the problem with the drawing file itself (attached)? 

 

Below is my current code which use TableRecord which still does not works. Before that I have tried other iteration using other method which all could not detect the unreferenced xrefs. Just for your information, what  I am doing is to create a lisp that will detach all unloaded, unreferenced, unfound data link and only leave the loaded xref. this process is requisite for other process to bind all xref.

 

(defun c:DetachAllXrefs ( / doc bt tr name)
  (vl-load-com)
  (princ "\nStarting Xref check...")
  
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq bt (vla-get-Blocks doc))
  
  ;; Function to safely check if name matches unreferenced pattern
  (defun is-unreferenced (name)
    (or (wcmatch name "`**")     ; handles special characters
        (wcmatch name "$*")      ; handles $ prefix
        (wcmatch name "*|*")     ; handles vertical bar
        (= name "GESB")          ; specific name
    )
  )
  
  ;; Iterate through block table
  (vlax-for tr bt 
    (progn
      (setq name (vla-get-Name tr))
      (princ (strcat "\nChecking: " name))
      
      (if (is-unreferenced name)
        (progn
          (princ (strcat "\n  Found possible unreferenced Xref: " name))
          (vl-catch-all-apply 
            '(lambda ()
               (vla-put-IsXref tr :vlax-true)
               (vla-Delete tr)
               (princ (strcat "\n  Successfully removed: " name))
             )
          )
        )
      )
    )
  )
  
  ;; Try alternative method for any remaining unreferenced xrefs
  (if (setq ss (ssget "X" '((0 . "INSERT"))))
    (progn
      (setq i 0)
      (repeat (sslength ss)
        (setq ent (ssname ss i))
        (setq entl (entget ent))
        (if (and (assoc 2 entl)
                 (is-unreferenced (cdr (assoc 2 entl))))
          (progn
            (princ (strcat "\nAttempting to remove unreferenced entity: " 
                          (cdr (assoc 2 entl))))
            (entdel ent)
          )
        )
        (setq i (1+ i))
      )
    )
  )
  
  (princ "\nProcessing completed. Please QSAVE and REOPEN the drawing to verify changes.")
  (princ)
)

 

 

TB-TM-GCH3_A1.dwg

[Nikon]

6 hours ago, MAzri said:

My mind going crazy over this. All code iteration i tried could not find the unreferenced xrefs and thus it could not process to detach it. even simple -xref, D, * could not find any xref. Is the problem with the drawing file itself (attached)?

Paste into the command line, Click enter
(vl-cmdf "_.-image" "_D" "*")

TB-TM-GCH3_A1-1.dwg

[rlx]

found something that kicks them all out , but therefore also not very selective...

 

;;; https://autocadtips1.com/2011/09/01/autolisp-detach-all-xrefs/
(defun C:Detachall  (/ *error* mip:layer-status-restore mip:layer-status-save delete-xref-img-underlay delete-all-dict)
  (vl-load-com)
  (defun *error* (msg) (mip:layer-status-restore) (princ msg) (princ))
  (defun mip:layer-status-restore  ()
    (foreach item  *PD_LAYER_LST*
      (if (not (vlax-erased-p (car item)))
        (vl-catch-all-apply '(lambda ()(vla-put-lock (car item)(cdr (assoc "lock" (cdr item))))
             (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))))))
    (setq *PD_LAYER_LST* nil)
  )

  (defun mip:layer-status-save ()
    (setq *PD_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *PD_LAYER_LST* (cons (list item (cons "freeze" (vla-get-freeze item)) (cons "lock" (vla-get-lock item))) *PD_LAYER_LST*))
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
        (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
    )
  )

  (defun delete-xref-img-underlay  (/ count txt)
    (mip:layer-status-save)
    (vlax-for Blk (vla-get-Blocks (vla-get-activedocument (vlax-get-acad-object)))
      (if (and (= (vla-get-IsXref Blk) :vlax-false) (not (wcmatch (vla-get-name Blk) "*|*")))
        (progn
          (setq count 0 txt (strcat " Erase Xref and Underlay in " (vla-get-name Blk)))
          (grtext -1 txt)
          (vlax-for Obj  Blk
            (setq count (1+ count))
            (if (zerop (rem count 10)) (grtext -1 (strcat txt " : " (itoa count))))
            (if (and (vlax-write-enabled-p Obj)
                     (or (and (= (vla-get-ObjectName obj) "AcDbBlockReference")(vlax-property-available-p Obj "Path"))
                         (and (wcmatch (vla-get-ObjectName obj) "*Reference")(vlax-property-available-p Obj "UnderlayName"))
                         (= (vla-get-ObjectName obj) "AcDbRasterImage"))) (vl-catch-all-apply 'vla-Delete (list Obj))))))
    )
    (mip:layer-status-restore)
  )

  ;;; dict - dict name (like "ACAD_IMAGE_DICT", "ACAD_PDFDEFINITIONS" ... )
  (defun delete-all-dict  (dict)
    (vl-catch-all-apply
      '(lambda ()
         (vlax-map-Collection (vla-item (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))) dict) 'vla-delete)))
  )

  (vl-load-com)
  (delete-xref-img-underlay)
  (command "_-xref" "_d" "*")
  (while (> (getvar "CMDACTIVE") 0) (command))
  (mapcar 'delete-all-dict (list "ACAD_IMAGE_DICT" "ACAD_PDFDEFINITIONS" "ACAD_DWFDEFINITIONS" "ACAD_DGNDEFINITIONS"))
  (command "_.regenall") (command "_.externalreferences")
  (princ)
)

(C:Detachall)

 

[MAzri]

29 minutes ago, Nikon said:

Paste into the command line, Click enter
(vl-cmdf "_.-image" "_D" "*")

TB-TM-GCH3_A1-1.dwg 903.09 kB · 0 downloads

 

Oh, its images! no wonder. I must be insane already for not noticing that. No wonder it didnt listed the xref no matter what. However, this will remove all images included loaded one. Thanks anyway for pointing this out.

 

11 minutes ago, rlx said:

found something that kicks them all out , but therefore also not very selective...

 

yea this is very neat to remove all. thanks for sharing this but i will need to filter unresolved, unreferenced, not found, unloaded type. I kinda remember JTB Fixrefs do very good job at this but my company not buying this and i already expire my trial period.

[meinfilel]

;;  PurgeImages.lsp by Trevor Bird
;; Removes Unreferenced Images
;;  2021-02-20

;;------------------------------------------------------------------------------
(defun purgeimages
  (
    /

    ACAD_IMAGE_DICT__dxf
    ACAD_IMAGE_DICT__ename
    ACAD_REACTORS__dxf
    assoc_330

    count_imagedef
    count_imageref
    count_purged

    dps_3
    dps_330

    entity_dxf
    entity_ename
    entity_type

    imagedef_dxf
    imagedef_ename
    ImageFile
    imageref_dxf
    imageref_ename

    list_ImageNames
  )
  (setq count_purged  0)

  (cond
    (  (not (setq ACAD_IMAGE_DICT__dxf    (dictsearch (namedobjdict) "ACAD_IMAGE_DICT"))))
    (  (not (setq ACAD_IMAGE_DICT__ename  (cdr (assoc -1 ACAD_IMAGE_DICT__dxf)))))

      ;;  dps_3 = xrecord names = image names
    (  (not (setq dps_3  (vl-remove-if-not '(lambda ( _dp ) (= (car _dp) 3)) ACAD_IMAGE_DICT__dxf))))

      ;;  List of xrecord names = list of image Names
    (  (not (setq list_ImageNames  (mapcar 'cdr dps_3))))

    (list_ImageNames
      (foreach fe__ImageName list_ImageNames
        (setq imagedef_dxf    (dictsearch ACAD_IMAGE_DICT__ename fe__ImageName)
              imagedef_ename  (cdr (assoc -1 imagedef_dxf))
              ImageFile       (cdr (assoc 1 imagedef_dxf))
        );setq

        (cond
          (  (not (setq ACAD_REACTORS__dxf  (member  '(102 . "{ACAD_REACTORS") imagedef_dxf))))
          (  (not
                (setq ACAD_REACTORS__dxf  (reverse (member '(102 . "}") (reverse ACAD_REACTORS__dxf)))
                      dps_330             (vl-remove-if-not '(lambda ( _dp ) (= (car _dp) 330)) ACAD_REACTORS__dxf)
                );setq
            );not
          );

          (dps_330
            (setq count_imagedef  0
                  count_imageref  0
            );setq

            (foreach fe__dp dps_330
              (setq entity_ename  (cdr fe__dp)
                    entity_dxf    (entget entity_ename)
                    entity_type   (cdr (assoc 0 entity_dxf))
              );setq

              (cond
                (  (not (= entity_type "IMAGEDEF_REACTOR")))

                (  (not (setq count_imagedef  (1+ count_imagedef))))

                  ;;  330 - Object ID for associated image object (image reference)
                (  (not (setq assoc_330  (assoc 330 entity_dxf))))

                (assoc_330
                  (setq imageref_ename  (cdr assoc_330)
                        imageref_dxf    (entget imageref_ename)
                  );setq

                  (cond
                    (  (not imageref_dxf)
                      ;;  Image reference was deleted.
                    );(not imageref_dxf)

                    (imageref_dxf
                      (setq count_imageref  (1+ count_imageref))
                    );imageref_dxf
                  );cond
                );assoc_330
              );cond
            );fe__dp


            (if (zerop count_imageref)
              (progn
                ;;  Delete image definition xrecord.
                (setq count_purged  (1+ count_purged))
                (entdel imagedef_ename)
                (dictremove ACAD_IMAGE_DICT__ename fe__ImageName)

                (princ "\nDeleting image ")
                (prin1 fe__ImageName)
                (princ ".")
              );progn
            );if
          );dps_330
        );cond`
      );fe__ImageName
    );list_ImageNames
  );cond


  (cond
    (  (not (zerop count_purged))
      (princ "\n")
      (prin1 count_purged)

      (if (> count_purged 1)
        (princ " images ")
        (princ " image ")
      );if

      (princ "deleted.")
    );(not (zerop count_purged))

    (  (zerop count_purged)
      (princ "\nNo unreferenced images found.")
    );(zerop count_purged)
  );cond


  (princ)
)    ;c:purgeimages

 

Edited April 17 by SLW210
Added Code Tags!!

[SLW210]

Please use Code Tags for your code in the future. (<> in the editor toolbar)