Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Detach All Xref Lisp

2 REPLIES 2
SOLVED
Reply
Message 1 of 3
CSM_MAI
5761 Views, 2 Replies

Detach All Xref Lisp

Hello,

 

I found the lisp below at this link. https://autocadtips1.com/2011/09/01/autolisp-detach-all-xrefs/

 

It works great, but I wanted to know if there was some way to add an "if" statement that would look for attachements, then do the routine, and if it doesn't find attachments, jump to a display message in the command prompt, along the lines of (princ "\nNo References to Detach...")  

 

I figured I would add (progn somewhere in the lisp, but I am not certain where to add it. Any information on this would be appreciated. Thanks. 

 

 

 

(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)
) ;_ end of defun
(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)))
) ;_ end of vla-put-freeze
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of foreach
(setq *PD_LAYER_LST* nil)
) ;_ end of defun
(defun mip:layer-status-save ()
(setq *PD_LAYER_LST* nil)
(vlax-for item (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-layers
(setq *PD_LAYER_LST*
(cons (list item
(cons "freeze" (vla-get-freeze item))
(cons "lock" (vla-get-lock item))
) ;_ end of cons
*PD_LAYER_LST*
) ;_ end of cons
) ;_ end of setq
(vla-put-lock item :vlax-false)
(if (= (vla-get-freeze item) :vlax-true)
(vl-catch-all-apply
'(lambda () (vla-put-freeze item :vlax-false))
) ;_ end of vl-catch-all-apply
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of defun
(defun delete-xref-img-underlay (/ count txt)
(mip:layer-status-save)
(vlax-for Blk (vla-get-Blocks
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-Blocks
(if (and (= (vla-get-IsXref Blk) :vlax-false)
(not (wcmatch (vla-get-name Blk) "*|*"))
) ;_ end of and
(progn
(setq count 0
txt (strcat " Erase Xref and Underlay in "
(vla-get-name Blk)
) ;_ end of strcat
) ;_ end of setq
(grtext -1 txt)
(vlax-for Obj Blk
(setq count (1+ count))
(if (zerop (rem count 10))
(grtext -1 (strcat txt " : " (itoa count)))
) ;_ end of if
(if
(and (vlax-write-enabled-p Obj)
(or
(and ;_ XREF
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-property-available-p Obj "Path")
) ;_ end of and
(and ;_ UNDERLAY
(wcmatch (vla-get-ObjectName obj) "*Reference")
(vlax-property-available-p Obj "UnderlayName")
) ;_ end of and
(= (vla-get-ObjectName obj) "AcDbRasterImage") ;_ IMAGE
) ;_ end of or
) ;_ end of and
(VL-CATCH-ALL-APPLY 'vla-Delete (list Obj))
) ;_ end of if
) ;_ end of vlax-for
) ;_ end of progn
) ;_ end of if
) ;_ end of vlax-for
(mip:layer-status-restore)
) ;_ end of defun
(defun delete-all-dict (dict)
;;; dict - dict name (like "ACAD_IMAGE_DICT", "ACAD_PDFDEFINITIONS" ... )
(vl-catch-all-apply
'(lambda ()
(vlax-map-Collection
(vla-item
(vla-get-dictionaries
(vla-get-activedocument (vlax-get-acad-object))
) ;_ end of vla-get-dictionaries
dict ;_ "ACAD_IMAGE_DICT"
) ;_ end of vla-Item
'vla-delete
) ;_ end of vlax-map-Collection
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of defun
(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"
) ;_ end of list
) ;_ end of mapcar
(command "_.regenall")
(command "_.externalreferences")
(princ)
) ;_ end of defun

2 REPLIES 2
Message 2 of 3
hencoop
in reply to: CSM_MAI

This should do it... it checks for xreferences and if they exist it runs (C:DETACHALL).  Otherwise it tells you there are none:

I extracted this code from another of my functions where I make use of the value of 'xref-lst.  I left the construction of the list as I use it. 

(DEFUN c:detachxrefs ( / block-lst xref-lst nxt-blk n)
  (PROGN
    (SETQ block-lst (LIST (TBLNEXT "BLOCK" T)))
    (SETQ xref-lst NIL)
    (WHILE (SETQ nxt-blk (TBLNEXT "BLOCK"))
      (SETQ block-lst (APPEND block-lst (LIST nxt-blk)))
    ) ;_ end of WHILE
    (FOREACH n block-lst
      (IF (AND (ASSOC 70 n) (EQ (BOOLE 1 4 (CDR (ASSOC 70 n))) 4))
         (SETQ xref-lst
                (APPEND
                  xref-lst
                  (LIST (LIST (CDR (ASSOC 2 n)) (CDR (ASSOC 1 n)))
                  ) ;_ end of LIST
                ) ;_ end of APPEND
            ) ;_ end of SETQ
      ) ;_ end of IF
    ) ;_ end of FOREACH
    (IF xref-lst
      (c:detachall)
      (PROGN
        (PRINC "\nNo References to Detach... ")
        (PRINC)
      )
    ) ;_ end of IF
    (PRINC)
  ) ;_ end of PROGN
) ;_ end of defun

 

AutoCAD User since 1989. Civil Engineering Professional since 1983
Product Ver.: 13.6.1781.0 Civil 3D 2024.3 Update
Built On:        U.152.0.0 AutoCAD 2024.1.2
                        27.0.37.14 Autodesk AutoCAD Map 3D 2024.0.1
                        8.6.52.0 AutoCAD Architecture 2024
Message 3 of 3
CSM_MAI
in reply to: hencoop

This worked great. Thank you for taking the time to look at this. Have a good day. 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost