[原创] 清理空組ＬＩＳＰ程序和ＶＢＡ程序

BDYCAD

現在寫出清理空組的ＬＩＳＰ程序和尹凡版主用ＶＢＡ清理空組的程序和大家分享，還望大家多多提出寶貴的見議和指導． ;-----------------------------------------------------------------------------
;清理空組程序源碼
;Make by:　ＢＤＹＣＡＤ
;Date : 2004-03-07
(defun c:DELG (/ i group glist delgro)
(setq group (vla-get-groups
(vla-get-Activedocument (vlax-get-acad-object))
)
)
(setq i 0); 循還初始值設定
(repeat (vla-get-count group); 列出空組的組表
(if (= (vla-get-count (setq glist (vla-item group i))) 0)
(setq delgro (cons (vla-get-name glist) delgro))
)
(setq i (+ i 1))
)
(setq i 0)
(setvar "cmdecho" 0); 關閉命令行回顯
(command ;|MSG0|;"_.undo" ;|MSG0|;"_group")
(REPEAT (length delgro); 循還清除空組組名
(command ".group""e" (nth i delgro))
(setq i (1+ i)))
(command ;|MSG0|;"_.undo" ;|MSG0|;"_end")
(setvar "cmdecho" 1)
(princ"\n現在以將空組清理了. ")
(princ)
) ＶＢＡ的做法， －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 編寫：尹凡 Sub test()
Dim GroupObj As AcadGroup
For Each GroupObj In ThisDrawing.Groups
GroupObj.Delete
Next
End Sub '是清除，就是說只有當組中的實體數據為零時才刪除。
Sub testB()
Dim GroupObj As AcadGroup
For Each GroupObj In ThisDrawing.Groups
If GroupObj.count = 0 Then GroupObj.Delete
Next
End Sub

myfreemind

不错~~好程序！

xdgumelon

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

xiaowen

 很感谢楼主分享,多谢了.

原地踏步

感觉在实际应用中，只包含一个图元的组也没多大用处，可作为空组处理。

不知楼主能否增加这个选项。

清风明月名字

谢谢楼主！又学一招。