[试用]：发个清理无用组的东东(VBA)

neo

不包含任何图元的组留在CAD文档中占用了不少资源，尤其是反复编辑的图形。。
本人习惯用lisp加载VBA.。看下附件中的lisp文件救治道用法了。。

782150yhm

楼主里面的后缀名不是。lsp的文件怎么加载

neo

这个程序是用VBA写的，压缩包里有个Clear_grp.lsp文件，
打开，然后改一下"clear_grp.dvb"所在的目录。加载lisp就可以了。适用于ACAD2005。
键入 “clg”就可以运行了。完了 "clear_grp.dvb"会被卸载。不会留在内存里。只有很小的Clear_grp.lsp会留下。。

tjdxzp

谢谢楼主,已经下载!

andyhua5240

谢谢楼主的东东，希望理正能加入和这个类似的清理无用组的程序。因为理正的很多对象都是用组存在的，而别人如果不用理正的话，就会删除组，这样组的信息仍然留存在了CAD文件中。希望QUN能加入清理无用组的程序。谢谢！

Qun

不用理正组也照样有用处。

秋枫

昨天打开一张地形图，6M多。一使用Group命令AutoCAD就死掉。初步判断是图中的组太多了。用用楼主的清除空组程序试试，一样的死法。想来是对话框创建列表时出问题了，几百条可以忍受，但几十万个组下来，标准Group命令都死翘翘了，不要说你的这个程序。其中绝大部分是空组。

最后，只好自己动手写清除空组的命令行版本的程序，不要对话框了。大概运行了二十分钟有的吧，清除了几十万个空组。清完后保存DWG，原来6M的文件变成了1M。

2. 
   
3. (vl-load-com)
   
4. 
   
5. (defun C:PurgeGroup (/ gnList doc groups g)
   
6.   (princ
   
7.     "\n此程序搜索不包含任何物体的空组并清除之\n"
   
8.   )
   
9.   (setq doc (vla-get-activedocument (vlax-get-acad-object)))
   
10.   (setq groups (vla-get-groups doc))
    
11.   (vlax-for g groups
    
12.     (princ "\n分析组：")
    
13.     (princ (vla-get-name g))
    
14.     (if        (= (vla-get-count g) 0)
    
15.       (progn
    
16.         (princ (strcat "......删除空组" (vla-get-name g)))
    
17.         (vla-delete g)
    
18.       )
    
19.     )
    
20.     (princ)
    
21.   )
    
22. )

<br /> (vl-load-com)<br /> <br /> (defun C:PurgeGroup (/ gnList doc groups g)<br />   (princ<br />     "\n此程序搜索不包含任何物体的空组并清除之\n"<br />   )<br />   (setq doc (vla-get-activedocument (vlax-get-acad-object)))<br />   (setq groups (vla-get-groups doc))<br />   (vlax-for g groups<br />     (princ "\n分析组：")<br />     (princ (vla-get-name g))<br />     (if        (= (vla-get-count g) 0)<br />       (progn<br />         (princ (strcat "......删除空组" (vla-get-name g)))<br />         (vla-delete g)<br />       )<br />     )<br />     (princ)<br />   )<br /> )

andyhua5240

谢谢，秋枫大哥，要的就是这个程序！

Quelea

忽然想到，只包含一个物体的组也是没有意义的，是不是也应该清理掉？

修改一下：上面的PurgeGroup.lsp中的那行：

1. (if (= (vla-get-count g) 0)

复制代码

改为

1. (if (< (vla-get-count g) 2)

复制代码

可以清理空组或只含一个物体的组。

雅南

多谢了，我就是需要这样的东西呀

立顿红茶

这两天我也正为这个发愁。
请教各位高手，我的一张总图在清理重线和清理图元的时候，就自动跳出来了。怎么办？还是方案的初期，画到后面会更大，图层更多了，就怕画到画到就突然了跳出来了。
在分解一个块的时候也自动跳出来了。

zweilili

我试用了这几周觉得这个程序已经非常完善了，若秋枫大侠不介意理正完全可以加入这个有用的东东！

eachy

还可以用更高效率的代码，49999个组 9.x 秒

秋枫

最初由 eachy 发布
[B]还可以用更高效率的代码，49999个组 9.x 秒 [/B]

有空我试试vlax-map-collection看。（你的这个测试是否在命令行上打印信息？）

eachy

打印信息是为了测试用的

2. 
   
3. ;;程序开始
   
4. (setq s              (getvar "date")
   
5.       seconds (* 86400.0 (- s (fix s)))
   
6. )
   
7. ;;程序结束
   
8. (princ "耗时 ")
   
9. (princ
   
10.   (- (* 86400.0 (- (getvar "date") (fix (getvar "date"))))
    
11.      seconds
    
12.   )
    
13. )
    
14. (princ " s!")

<br /> ;;程序开始<br /> (setq s              (getvar "date")<br />       seconds (* 86400.0 (- s (fix s)))<br /> )<br /> ;;程序结束<br /> (princ "耗时 ")<br /> (princ<br />   (- (* 86400.0 (- (getvar "date") (fix (getvar "date"))))<br />      seconds<br />   )<br /> )<br /> (princ " s!")