BDYCAD 发表于 2004-3-7 09:40:00

[原创] 清理空組LISP程序和VBA程序

現在寫出清理空組的LISP程序和尹凡版主用VBA清理空組的程序和大家分享,還望大家多多提出寶貴的見議和指導.


;-----------------------------------------------------------------------------<BR>;清理空組程序源碼<BR>;Make by: BDYCAD<BR>;Date : 2004-03-07<BR>(defun c:DELG (/ i group glist delgro)<BR>       (setq        group (vla-get-groups<BR>                                       (vla-get-Activedocument (vlax-get-acad-object))<BR>                       )<BR>       )<BR>       (setq i 0); 循還初始值設定<BR>       (repeat (vla-get-count group); 列出空組的組表<BR>                       (if        (= (vla-get-count (setq glist (vla-item group i))) 0)<BR>                                       (setq delgro (cons (vla-get-name glist) delgro))<BR>                       )<BR>                       (setq i (+ i 1))<BR>       )<BR>       (setq i 0)<BR>       (setvar "cmdecho" 0); 關閉命令行回顯<BR>       (command ;|MSG0|;"_.undo" ;|MSG0|;"_group")<BR>       (REPEAT (length delgro); 循還清除空組組名<BR>                       (command ".group""e" (nth i delgro))<BR>                       (setq i (1+ i)))<BR>       (command ;|MSG0|;"_.undo" ;|MSG0|;"_end")<BR>       (setvar "cmdecho" 1)<BR>       (princ"\n現在以將空組清理了. ")<BR>       (princ)<BR>)






VBA的做法,


--------------------------------


編寫:尹凡


Sub test()<BR>                       Dim GroupObj As AcadGroup<BR>                       For Each GroupObj In ThisDrawing.Groups<BR>                                                       GroupObj.Delete<BR>                       Next<BR>End Sub


'是清除,就是說只有當組中的實體數據為零時才刪除。<BR>Sub testB()<BR>                       Dim GroupObj As AcadGroup<BR>                       For Each GroupObj In ThisDrawing.Groups<BR>                                                       If GroupObj.count = 0 Then GroupObj.Delete<BR>                       Next<BR>End Sub<BR>

myfreemind 发表于 2004-3-12 00:12:00

不错~~好程序!

xdgumelon 发表于 2007-12-25 10:11:00

顶啊,可以给图纸减肥哦,厉害@

xiaowen 发表于 2010-6-9 16:59:00

<p>&nbsp;很感谢楼主分享,多谢了.</p>

原地踏步 发表于 2010-6-15 10:18:00

<p>感觉在实际应用中,只包含一个图元的组也没多大用处,可作为空组处理。</p>
<p>不知楼主能否增加这个选项。</p>

清风明月名字 发表于 2013-6-28 19:05:38

谢谢楼主!又学一招。
页: [1]
查看完整版本: [原创] 清理空組LISP程序和VBA程序