找了很多拆除外部参照的程序,求助帮看看如何只拆除卸载或不存在参照的。
;: https://autocadtips1.com/2011/09/01/autolisp-detach-all-xrefs/ author unknown; (load "Detachall") Detachall ;
(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)))
)
)
)
)
)
(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)))
(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)))
)
)
) ;_ end of defun
(defun delete-xref-img-underlay (/ count txt BlkList)
(mip:layer-status-save)
(vlax-for Blk (vla-get-Blocks(vla-get-activedocument (vlax-get-acad-object)))
(setq BlkList (entget(vlax-vla-object->ename Blk)))
(vl-catch-all-apply 'eval
'((setq data2
(entget
(cdr
(assoc 360
(setq data1
(entget
(vlax-vla-object->ename blk)
)
)
)
)
)
))
)
(if(and
(= (vla-get-IsXref Blk) :vlax-false)
(not (wcmatch (vla-get-name Blk) "*|*")
;(logand(assoc 70 BlkList)32)
;(not(logand(assoc 70 BlkList)32))
)
;(member '(71 . 1) date2)
)
(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 ;_ XREF
(= (vla-get-ObjectName obj) "AcDbBlockReference")
(vlax-property-available-p Obj "Path")
;(member '(71 . 1) data2)
;(logand(assoc 70 BlkList)32)
(not(logand(assoc 70 BlkList)32))
) ;_ 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)))dict)
'vla-delete
) ;_ end of vlax-map-Collection
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of defun
(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)
) ;_ end of defun找了很多拆除外部参照的,或多或少有的会出现错误,,有点拆除清理不彻底,,这个还是比较好的,但是就是是全部拆除,,本人也试了好久研究下,但是确实对面对对象的太生疏,确实没那个能力。只好发出来看有没大佬给看看,怎么加个拆除条件,就是外部参照不存在或者已经卸载就清理外部参照列表。。之前有大哥发过,,还是再发下吧,,感觉挺好的代码,,沉了可惜。。
嵌套的参照得逐层拆除。
用到递归
可以参考一下这个帖子http://bbs.mjtd.com/thread-186503-1-1.html
页:
[1]