拆掉找不到文件的参照
本帖最后由 sandyvs 于 2023-2-21 17:35 编辑应该算是解决了吧，不过之前应该清理一下。最开始总是不成功，后来才发现参照的文件有多重参照
感谢@vitalgg ！！
本帖最后由 vitalgg 于 2023-2-21 18:21 编辑
(foreach xref (block:list-xref-objs)
(if (and (setq path (vla-get-Path xref))
(/= "" path)
(null (findfile path)))
(vla-detach xref)
))
查询文件是否存在 应该是 findfile 。
函数：block:list-xref-objs 源码见：
https://atlisp.cn/function/block:list-xref-objs
vitalgg 发表于 2023-2-19 21:00
函数：block:list-xref-objs 源码见：
https://atlisp.cn/function/block:list-xref-objs
感谢回复！其实主要现在对lisp连入门也算不上，只是搜索自己想要的功能，进行一些简单的修改。我知道思路应该是判断参照路径存在不存在，如果不存在就拆离。只是不会用编程表达出来，先慢慢研究研究，要学习的还很多。。 本帖最后由 sandyvs 于 2023-2-21 17:16 编辑
vitalgg2023-2-19 21:00
block:list-xref-objs
https://atlisp.cn/function/block:list-xref-objs
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-objs)
(if (and (setq path (vla-get-Path xref))
(/= "" path)
(null (findfile path)))
(vla-detach xref)
))
)
是这个意思不？我说没找到find函数。。
sandyvs 发表于 2023-2-21 17:15
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-o ...
你是对的，应该是 findfile sandyvs 发表于 2023-2-21 17:15
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-o ...
问下 *blks*在哪里？？ sandyvs 发表于 2023-2-21 17:15
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-o ...
(defun c:Detachall nil (hlj:Detachall nil))
(defun c:DetachNotExist nil (hlj:Detachall t))
(vl-load-com)
(defun *error* (msg)
(mip:layer-status-restore)
(princ msg)
(princ)
) ;_ end of defun
;;-------------=={ Relative Path to Full Path }==-------------;;
;; ;;
;;Converts a Relative XRef path to a Full Path. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;dir- Directory of the Drawing in which the Xref resides ;;
;;path - Relative Xref Path ;;
;;------------------------------------------------------------;;
;;Returns:Full XRef Path ;;
;;------------------------------------------------------------;;
;;-------------==｛完整路径的相对路径｝==--------------；；
;; ;;
;; 将“相对外部参照”路径转换为“完整路径”；；
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;; 参数：；；
;; dir-外部参照所在图形的目录；；
;; path-相对外部参照路径；；
;;------------------------------------------------------------;;
;; 返回：完整外部参照路径；；
;;------------------------------------------------------------;;
(defun LM:XRef:Relative->Full (dir path)
(setq dir (vl-string-right-trim "\\" dir))
(cond
( (eq ".." (substr path 1 2))
(LM:XRef:Relative->Full
(substr dir 1 (vl-string-position 92 dir nil t))
(substr path 4)
)
)
( (eq "." (substr path 1 1))
(strcat dir (substr path 2))
)
( (strcat dir "\\" path))
)
)
;;-------------=={ Full Path to Relative Path }==-------------;;
;; ;;
;;Converts a Full XRef path to a Relative Path. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;dir- Directory of the Drawing in which the Xref resides ;;
;;path - Full Xref Path ;;
;;------------------------------------------------------------;;
;;Returns:Relative XRef Path ;;
;;------------------------------------------------------------;;
;(defun LM:XRef:Full->Relative ( dir path / p q )
; (setq dir (vl-string-right-trim "\\" dir))
; (cond
; ( (and
; (setq p (vl-string-position 58dir))
; (setq q (vl-string-position 58 path))
; (not (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q))))
; )
; path
; )
; ( (and
; (setq p (vl-string-position 92dir))
; (setq q (vl-string-position 92 path))
; (eq (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
; )
; (LM:Xref:Full->Relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
; )
; ( (and
; (setq q (vl-string-position 92 path))
; (eq (strcase dir) (strcase (substr path 1 q)))
; )
; (strcat ".\\" (substr path (+ 2 q)))
; )
; ( (eq "" dir)
; path
; )
; ( (setq p (vl-string-position 92 dir))
; (LM:Xref:Full->Relative (substr dir (+ 2 p)) (strcat "..\\" path))
; )
; ( (LM:Xref:Full->Relative "" (strcat "..\\" path)))
; )
;)
(defun mip:layer-status-restore ( /item)
(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 ( /item)
(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 (exclude / blk count obj 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")
(not(and exclude (findfile(LM:XRef:Relative->Full (getvar "DWGPREFIX") (Vlax-Get 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
(defun hlj:Detachall (exclude /)
(vl-load-com)
(delete-xref-img-underlay exclude)
(command "_-xref" "_d" "*")
(while (> (getvar "CMDACTIVE") 0) (command))
(mapcar 'delete-all-dict
(list "ACAD_IMAGE_DICT"
"ACAD_PDFDEFINITIONS"
"ACAD_DWFDEFINITIONS"
"ACAD_DGNDEFINITIONS"
"ACAD_DATALINK"
) ;_ end of list
) ;_ end of mapcar
(command "_.regenall")
(command "_.externalreferences")
(princ)
) ;_ end of defun
;(defun block:list-xref-objs (/ res)
;;"获取外部参照对象列表"
;;"外部参照对象列表"
;;""
;(setq res nil)
;(vlax-for blk *blks* (if (= :vlax-true (vla-get-isxref blk))
; (setq res (cons blk res))))
;res)
记得你是不是发过这个，，感觉很牛的样子，，我瞎研究了好几次，奈何自己没半点什么面向对象的编程能力，不知有没有大佬给看看，，调教下？？功能就是要删除已经卸载的外部参照，好像不管怎么设置都是删除全部。。。有侵权的联系删除，，谢谢！！ yaojing38 发表于 2023-3-14 21:07
记得你是不是发过这个，，感觉很牛的样子，，我瞎研究了好几次，奈何自己没半点什么面向对象的编程能力 ...
不好使，所以不用这个了，缺的函数，2楼网址有 sandyvs 发表于 2023-3-14 23:22
不好使，所以不用这个了，缺的函数，2楼网址有
已卸载的不能删除是吧？？主键重复 位置，是什么东西？？
页:
[1]