明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 407|回复: 2

[源码] 找了很多拆除外部参照的程序,求助帮看看如何只拆除卸载或不存在参照的。

[复制链接]
发表于 2023-3-15 15:50:56 | 显示全部楼层 |阅读模式
  1. ;: https://AutoCADtips1.com/2011/09/01/autolisp-detach-all-xrefs/ author unknown
  2. ; (load "Detachall") Detachall ;
  3. (defun C:Detachall (/ *error* mip:layer-status-restore mip:layer-status-save delete-xref-img-underlay delete-all-dict)

  4.   (defun *error* (msg)
  5.   (mip:layer-status-restore)
  6.   (princ msg)
  7.   (princ)
  8.   ) ;_ end of defun

  9.   (defun mip:layer-status-restore ()
  10.   (foreach item *PD_LAYER_LST*
  11.     (if (not (vlax-erased-p (car item)))
  12.     (vl-catch-all-apply
  13.       '(lambda ()
  14.       (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
  15.       (vla-put-freeze
  16.         (car item)
  17.         (cdr (assoc "freeze" (cdr item)))
  18.       )
  19.       )
  20.     )
  21.     )
  22.   )
  23.   (setq *PD_LAYER_LST* nil)
  24.   ) ;_ end of defun

  25.   (defun mip:layer-status-save ()
  26.   (setq *PD_LAYER_LST* nil)
  27.   (vlax-for item (vla-get-layers(vla-get-activedocument (vlax-get-acad-object)))
  28.     (setq *PD_LAYER_LST*
  29.     (cons
  30.       (list item (cons "freeze" (vla-get-freeze item))(cons "lock" (vla-get-lock item)))
  31.       *PD_LAYER_LST*
  32.     )
  33.     )
  34.     (vla-put-lock item :vlax-false)
  35.     (if (= (vla-get-freeze item) :vlax-true)
  36.     (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
  37.     )
  38.   )
  39.   ) ;_ end of defun

  40.   (defun delete-xref-img-underlay (/ count txt BlkList)
  41.   (mip:layer-status-save)

  42.   (vlax-for Blk (vla-get-Blocks(vla-get-activedocument (vlax-get-acad-object)))
  43.     (setq BlkList (entget(vlax-vla-object->ename Blk)))
  44.     (vl-catch-all-apply 'eval
  45.       '((setq data2
  46.             (entget
  47.                 (cdr
  48.                     (assoc 360
  49.                         (setq data1
  50.                             (entget
  51.                                 (vlax-vla-object->ename blk)
  52.                             )
  53.                         )
  54.                     )
  55.                 )
  56.             )
  57.         ))
  58.     )
  59.     (if(and
  60.       (= (vla-get-IsXref Blk) :vlax-false)
  61.       (not (wcmatch (vla-get-name Blk) "*|*")
  62.             ;(logand(assoc 70 BlkList)32)
  63.       ;(not(logand(assoc 70 BlkList)32))
  64.     )
  65.          ;(member '(71 . 1) date2)
  66.        )
  67.     (progn
  68.       (setq
  69.       count 0
  70.       txt (strcat " Erase Xref and Underlay in " (vla-get-name Blk))
  71.       )
  72.       (grtext -1 txt)
  73.       (vlax-for Obj Blk
  74.       (setq count (1+ count))
  75.       (if (zerop (rem count 10))(grtext -1 (strcat txt " : " (itoa count))))
  76.       (if
  77.         (and (vlax-write-enabled-p Obj)
  78.         (or
  79.           (and ;_ XREF
  80.           (= (vla-get-ObjectName obj) "AcDbBlockReference")
  81.           (vlax-property-available-p Obj "Path")
  82.           ;(member '(71 . 1) data2)
  83.       ;(logand(assoc 70 BlkList)32)
  84.       (not(logand(assoc 70 BlkList)32))
  85.           ) ;_ end of and
  86.           (and ;_ UNDERLAY
  87.           (wcmatch (vla-get-ObjectName obj) "*Reference")
  88.           (vlax-property-available-p Obj "UnderlayName")
  89.           ) ;_ end of and
  90.           (= (vla-get-ObjectName obj) "AcDbRasterImage") ;_ IMAGE
  91.         ) ;_ end of or
  92.         ) ;_ end of and
  93.         (VL-CATCH-ALL-APPLY 'vla-Delete (list Obj))
  94.       ) ;_ end of if
  95.       ) ;_ end of vlax-for
  96.     ) ;_ end of progn
  97.     ) ;_ end of if
  98.   ) ;_ end of vlax-for
  99.   (mip:layer-status-restore)
  100.   ) ;_ end of defun

  101.   (defun delete-all-dict (dict)
  102.   ;;; dict - dict name (like "ACAD_IMAGE_DICT", "ACAD_PDFDEFINITIONS" ... )
  103.   (vl-catch-all-apply
  104.     '(lambda ()
  105.     (vlax-map-Collection
  106.       (vla-item(vla-get-dictionaries(vla-get-activedocument (vlax-get-acad-object)))dict)
  107.       'vla-delete
  108.     ) ;_ end of vlax-map-Collection
  109.     ) ;_ end of lambda
  110.   ) ;_ end of vl-catch-all-apply
  111.   ) ;_ end of defun

  112.   (delete-xref-img-underlay)
  113.   (command "_-xref" "_d" "*")
  114.   (while (> (getvar "CMDACTIVE") 0) (command))
  115.   (mapcar 'delete-all-dict (list "ACAD_IMAGE_DICT" "ACAD_PDFDEFINITIONS" "ACAD_DWFDEFINITIONS" "ACAD_DGNDEFINITIONS"))
  116.   (command "_.regenall")
  117.   (command "_.externalreferences")
  118.   (princ)
  119. ) ;_ end of defun
找了很多拆除外部参照的,或多或少有的会出现错误,,有点拆除清理不彻底,,这个还是比较好的,但是就是是全部拆除,,本人也试了好久研究下,但是确实对面对对象的太生疏,确实没那个能力。只好发出来看有没大佬给看看,怎么加个拆除条件,就是外部参照不存在或者已经卸载就清理外部参照列表。。之前有大哥发过,,还是再发下吧,,感觉挺好的代码,,沉了可惜。。
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2023-3-15 16:04:40 | 显示全部楼层
嵌套的参照得逐层拆除。
用到递归
发表于 2023-3-15 16:09:08 | 显示全部楼层
可以参考一下这个帖子http://bbs.mjtd.com/thread-186503-1-1.html
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-16 10:32 , Processed in 0.174977 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表