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
Solved! Go to Solution.
Solved by hencoop. Go to Solution.
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