LISP to detach all XREF,PDF,IMAGE,ALL UNDERLAYS

Deleting an overlay does not remove the link to the source file. I'd provide you more but I'm on posting from iPhone.

Quote:

---

Originally Posted by RenderMan

Deleting an overlay does not remove the link to the source file. I'd provide you more but I'm on posting from iPhone.

---

Now that I'm home, here's some additional information:

Quote:

---

Originally Posted by AutoCAD User Guide, Detach DWF Underlay Files, Concept

DWF underlays can be detached from a drawing file.

You can detach DWF underlays that are no longer needed in a drawing. When you detach a DWF underlay, all instances of the underlay are removed from the drawing, the underlay definition is purged, and the linking path to the DWF file is removed.

Note
Erasing an individual instance of a DWF underlay is not the same as detaching it. A DWF underlay must be detached to remove the link from your drawing to the DWF file

---

Source

Just click on Procedure - same link as you posted, and you'll see that there is no other way to detach underlay objects then through palette "externalreferences"... All I wanted is to try to help (OP has hundreds of dwg files to revise, so without other way to detach - through routine, maybe the best way is to use what can be done, and that is to delete them)... The link to the underlay objects will remain, but he'll be able to see objects that are unlinked entities of dwg...

M.R.

This routine will do the trick, but it overwrites current dwg with new dwg without all underlays... Before using, it is strongly recommended that you make copy of all directories with all dwg files so that originals remain unchanged...

Code:

---

(defun c:detachall (/ adoc msp dwgname dwgscr scrf)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq msp (vla-get-modelspace adoc))
  (setq dwgname (vla-get-fullname adoc))
  (vlax-for ent        msp
    (vl-catch-all-apply 'vla-detach (list ent))
    (if
      (or
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-file (list ent))
          )
          nil
        )
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-path (list ent))
          )
          nil
        )
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-imagefile (list ent))
          )
          nil
        )
        (= (vla-get-objectname ent) "AcDbOle2Frame")
      )
      (vla-delete ent)
    )
  )
  (vl-cmdf "_.-xref" "D" "*")
  (vl-cmdf "_.-image" "D" "*")
  (if (ssget "_X" '((0 . "*UNDERLAY")))
    (vl-cmdf "_.externalreferences")
  )
  (vl-cmdf "_.-wblock" dwgname "Y" "*")
  (setq dwgscr (strcat (vl-string-right-trim "dwg" dwgname) "scr"))
  (setq scrf (open dwgscr "w"))
  (princ "close" scrf)
  (princ "\n" scrf)
  (princ "Y" scrf)
  (princ "\n" scrf)
  (princ "open" scrf)
  (princ "\n" scrf)
  (princ dwgname scrf)
  (princ "\n" scrf)
  (princ "shell" scrf)
  (princ "\n" scrf)
  (princ (strcat "erase " dwgscr) scrf)
  (princ "\n" scrf)
  (close scrf)
  (vl-cmdf "script" dwgscr)
  (princ)
)

---

M.R.

Hey, I'm not the one with this issue. I'm simply trying to provide accurate information on which a solid decision can be made. If half-right procedures works for you and or the OP, who am I to judge. That just wouldn't fly in my office.

Good luck with that. :wink:

Here is how you can quickly revise whole directory with *.dwg files in it...

Make sure you made copy of whole directory, for files in it will be overwritten...

Add this line to your acaddoc.lsp

Code:

---

(load "revise.lsp")

---

copy this file - code (revise.lsp) into ACAD Support directory...

Code:

---

(defun c:revise (/ adoc msp dwgname)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq msp (vla-get-modelspace adoc))
  (setq dwgname (vla-get-fullname adoc))
  (vlax-for ent        msp
    (vl-catch-all-apply 'vla-detach (list ent))
    (if
      (or
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-file (list ent))
          )
          nil
        )
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-path (list ent))
          )
          nil
        )
        (= (vl-catch-all-error-p
            (vl-catch-all-apply 'vla-get-imagefile (list ent))
          )
          nil
        )
        (= (vla-get-objectname ent) "AcDbOle2Frame")
      )
      (vla-delete ent)
    )
  )
  (vl-cmdf "_.-wblock" dwgname "Y" "*")
  (princ)
)

---

Start AutoCAD...
Load this file - code (reviseall.lsp) and start it

Code:

---

(defun c:reviseall ( / pthfn pth filens fn fnlst)
(setq pthfn (getfiled "Select one file in Folder where DWG files for revision are stored" "/" "dwg" 16))
(setq pth (substr pthfn 1 (vl-string-position (ascii "\\") pthfn 0 T)))
(if (setq filens (vl-directory-files pth "*.dwg"))
(foreach f filens
(progn (setq fn (strcat pth "\\" f)) (setq fnlst (cons fn fnlst)))
)
)
(setq revscr (open "c:/revscr.scr" "w"))
(foreach fn fnlst
(princ "open" revscr)
(princ "\n" revscr)
(princ fn revscr)
(princ "\n" revscr)
(princ "revise" revscr)
(princ "\n" revscr)
(princ "close" revscr)
(princ "\n" revscr)
(princ "Y" revscr)
(princ "\n" revscr)
)
(princ "open" revscr)
(princ "\n" revscr)
(princ pthfn revscr)
(princ "\n" revscr)
(princ "shell" revscr)
(princ "\n" revscr)
(princ "erase c:\\revscr.scr" revscr)
(princ "\n" revscr)
(close revscr)
(vl-cmdf "script" "c:/revscr.scr")
(princ)
)

---

After execution of routine, your files in selected directory will be without any underlays attached... You can check this by starting "XREF" command and you'll see that dialog box is now empty...

Regards,
M.R. :) :beer:

I would suggest looking into the various dictionaries to see if there is something in there that may relate to this topic. Autodesk has added many new features into AutoCAD via dictionaries.

My variant

Code:

---

(defun C:Detachall (/                              *error*
                    mip:layer-status-restore  mip:layer-status-save
                    delete-xref-img-underlay  delete-all-dict
                  )
  (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

---

Quote:

---

Originally Posted by azarko

My variant

Code:

---

(defun C:Detachall (/                              *error*
                    mip:layer-status-restore  mip:layer-status-save
                    delete-xref-img-underlay  delete-all-dict
                  )
  (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

---

---

azarko,
this works beautifully.
thanks
~Greg

After, attaching *.dgn, and then detaching it either using XREF dialog box, or azarko code, I still have layers definitions of unreferenced *.dgn only visible through "PURGE" command... It is impossible to delete them in same session with (command "purge" "a" "*" "n")... Only when I save this, empty of dgn, dwg file, close it and reopen, then I loose this definitions... My variant with command wblock, close and reopen, seems to does just that what is needful for getting rid of these unreferenced layers...

M.R.
See attached *.zip and check what I meant...