明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1321|回复: 18

[函数] 自定义清理

[复制链接]
发表于 2022-7-18 17:11 | 显示全部楼层 |阅读模式
本帖最后由 llsheng_73 于 2022-7-19 17:58 编辑

  1. ;|(Mpurge DOC'((groups t)(Layouts)(SelectionSets )(blocks)(layers)(textstyles)(dimstyles)(Linetypes)(Viewports)(Views)(UserCoordinateSystems)))
  2. 清理Doc文档下的空组、删除布局、空选择集、清理未引用块、字体样式、标注样式、线型、视口、视图、ucs;
  3. lst表每一项第一个为文档下的各种集合,出现第二项且非nilt时,清理该集合下的空对象,无第二项或第二项非真时,尽可能删除集合下所有对象;
  4. DOC为当前CAD对象下的任一文档对象或dbx对象,doc为nil或非文档对象时,被自动设置为当前文档|;
  5. (defun Mpurge(DOC LST / l n)
  6.   (or(not(VL-CATCH-ALL-ERROR-P(VL-CATCH-ALL-APPLY'vlax-get-property(List doc 'Database))))
  7.      (setq DOC(vlax-get-property(vlax-get-acad-object)'ActiveDocument)))
  8.   (vl-every(function(lambda(x / a b)
  9.                       (or(VL-CATCH-ALL-ERROR-P(setq a(VL-CATCH-ALL-APPLY 'vlax-get-property(list doc(car x)))))
  10.                          (progn(setq n(1+(vlax-get-property a'count)))
  11.                            (while(<(setq l(vlax-get-property a'count))n)
  12.                              (setq n l)
  13.                              (vlax-for y a
  14.                                (and(if(cdr x)(<(vlax-get-property y'count)1)t)
  15.                                    (VL-CATCH-ALL-APPLY 'vlax-invoke-method(list y 'delete))))))
  16.                          t)))LST))


测试时,我换2台电脑用2006清理嵌套块出错,但其它版本CAD下测试正常,不知道究竟是电脑问题还是CAD2006的问题




评分

参与人数 2明经币 +1 金钱 +5 收起 理由
唯我独翔 + 5
tigcat + 1 很给力!

查看全部评分

"觉得好,就打赏"
    共1人打赏
发表于 2022-7-18 22:13 | 显示全部楼层
;经过实测,楼主大大函数非常好用,感觉加一句"repeat"效果好一点
(setq LST '((layers)(groups t)(blocks)(blocks t)(textstyles)(dimstyles)) ;增加标注样式
(defun Mpurge (LST)

(repeat 3   ;一次好像清不干净,来3次
  (vl-every
    '(lambda (x / a b)
       (or
         (VL-CATCH-ALL-ERROR-P
           (setq a (VL-CATCH-ALL-APPLY
                     'vlax-get-property
                     (list (vlax-get-property      ;若用于dbx,修改此处
                             (vlax-get-acad-object)
                             'ActiveDocument
                           )
                           (car x)
                     )
                   )
           )
         )
         (if (cdr x)
           (vlax-for y a
             (and
               (< (vlax-get-property y 'count) 1)
               (VL-CATCH-ALL-APPLY 'vlax-invoke-method (list y 'delete))
             )
           )
           (vlax-for y a
             (VL-CATCH-ALL-APPLY 'vlax-invoke-method (list y 'delete))
           )
         )
         t
       )
     )
    lst
  )
);end repeat
)

 楼主| 发表于 2022-7-19 08:07 | 显示全部楼层
tigcat 发表于 2022-7-18 22:13
;经过实测,楼主大大函数非常好用,感觉加一句"repeat"效果好一点
(setq LST '((la ...

repeat实际上是没必要的,但为什么会一次搞不干净,其实是相互牵扯,比如一个图层没有任何东西,但有一个未被参照的图块里边用到了该图层,那么在这个图块被清理前,这个图层是清理不掉的,另外文字样式也一样,就算图中没有任何文字或属性,但同样的一个块里边用到了这个文字样式,它同样也只能在块被清理之后才能被清理掉

这样一来,由于一次性清理没太考究顺序问题,所以就会理清不干净,需要repeat几次后它就干净了,实际上,注意一下顺序就可以一次清理干净
发表于 2022-7-19 09:05 | 显示全部楼层
llsheng_73 发表于 2022-7-19 08:17
嵌套块确实会一次清理不掉,因为
假如A引用B,一般说来blocks里边,A先于B出现,但需要反过来先清理掉B ...

谢谢楼主耐心回复,这个程序最大的好处就是可以用来dbx,实现不开图批量清理。非常方便。这些天刚好在搜这个,搜遍全网,用lisp实现的就只看到1.2个,1个是楼主的,另外0.2个是MP的,他提供了伪源码。谢谢楼主大侠的经典源码!
发表于 2022-7-18 17:58 | 显示全部楼层
我怀疑这个清理功能可以用于dbx
 楼主| 发表于 2022-7-18 19:33 | 显示全部楼层
tigcat 发表于 2022-7-18 17:58
我怀疑这个清理功能可以用于dbx

(vlax-get-property(vlax-get-acad-object)'ActiveDocument)
这部分换成DBX对象就可以了
发表于 2022-7-18 21:40 | 显示全部楼层
llsheng_73 发表于 2022-7-18 19:33
(vlax-get-property(vlax-get-acad-object)'ActiveDocument)
这部分换成DBX对象就可以了

谢谢大佬,多日的疑惑或许马上就要解开,我先试验,这可是连沼泽MP都没具体回答的一个难题.
发表于 2022-7-18 22:12 | 显示全部楼层
感谢大佬分享
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-28 20:09 , Processed in 0.188362 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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