[原创] 清理空組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> 不错~~好程序! 顶啊,可以给图纸减肥哦,厉害@ <p> 很感谢楼主分享,多谢了.</p> <p>感觉在实际应用中,只包含一个图元的组也没多大用处,可作为空组处理。</p>
<p>不知楼主能否增加这个选项。</p> 谢谢楼主!又学一招。
页:
[1]