拆掉找不到文件的参照

sandyvs · 发表于 2023-2-19 13:07:20

本帖最后由 sandyvs 于 2023-2-21 17:35 编辑

应该算是解决了吧，不过之前应该清理一下。最开始总是不成功，后来才发现参照的文件有多重参照
感谢@vitalgg ！！

vitalgg · 发表于 2023-2-19 21:00:30

本帖最后由 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

sandyvs · 发表于 2023-2-19 22:39:50

vitalgg 发表于 2023-2-19 21:00
函数：block:list-xref-objs 源码见：
https://atlisp.cn/function/block:list-xref-objs

感谢回复！其实主要现在对lisp连入门也算不上，只是搜索自己想要的功能，进行一些简单的修改。我知道思路应该是判断参照路径存在不存在，如果不存在就拆离。只是不会用编程表达出来，先慢慢研究研究，要学习的还很多。。

sandyvs · 发表于 2023-2-21 17:15:45

本帖最后由 sandyvs 于 2023-2-21 17:16 编辑

vitalgg 2023-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函数。。

vitalgg · 发表于 2023-2-21 18:20:11

sandyvs 发表于 2023-2-21 17:15
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-o ...

你是对的，应该是 findfile

yaojing38 · 发表于 2023-3-14 21:01:22

sandyvs 发表于 2023-2-21 17:15
(defun c:tt()
(setq xref (ssget "X" (list '(0 . "INSERT") )))
(foreach xref (block:list-xref-o ...

问下 *blks* 在哪里？？

yaojing38 · 发表于 2023-3-14 21:07:34

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. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;; 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 58 dir))
; (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 92 dir))
; (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)

(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 &#169; 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 58  dir)) 
;                (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 92  dir)) 
;                (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)

记得你是不是发过这个，，感觉很牛的样子，，我瞎研究了好几次，奈何自己没半点什么面向对象的编程能力，不知有没有大佬给看看，，调教下？？功能就是要删除已经卸载的外部参照，好像不管怎么设置都是删除全部。。。有侵权的联系删除，，谢谢！！

sandyvs · 发表于 2023-3-14 23:22:29

yaojing38 发表于 2023-3-14 21:07
记得你是不是发过这个，，感觉很牛的样子，，我瞎研究了好几次，奈何自己没半点什么面向对象的编程能力 ...

不好使，所以不用这个了，缺的函数，2楼网址有

yaojing38 · 发表于 2023-3-15 09:58:38

sandyvs 发表于 2023-3-14 23:22
不好使，所以不用这个了，缺的函数，2楼网址有

已卸载的不能删除是吧？？主键重复位置，是什么东西？？

账号		自动登录	找回密码
密码			注册