块产生的废组也能清理

wyj_007

;; pugroup.lsp
(defun pugroup_error (s)
(if (/= s ;|MSG1|;"Function cancelled")
(princ (strcat ;|MSG2|;"\nError: " s))
)
(setq *error* old_error)
(setvar ;|NOXLATE|;"tilemode" old_tilemode)
(princ)
)
(defun Hasent(grpdict grpname)
(setq group (dictsearch (cdar grpdict) grpname))
(setq gromeb(cdr (assoc 340 group)))
(if (= (cdr (assoc 70 group)) 3)
nil
t)
)
(defun C:pugroup ( / grpdict name echo0 tilemode0 pick0 count1 count2 count3 )
(setq old_error *error*
*error* pugroup)
(setq echo0 (getvar ;|NOXLATE|;"cmdecho")
tilemode0 (getvar ;|NOXLATE|;"tilemode")
pick0 (getvar ;|NOXLATE|;"pickstyle")
)
(setvar ;|NOXLATE|;"cmdecho" 0)
(setvar ;|NOXLATE|;"pickstyle" 0)
(setq grpdict nil
name nil
count1 0
count2 0
count3 0
)
(setvar ;|NOXLATE|;"tilemode" 1)
(setq grpdict (dictsearch ;|p300d|;(namedobjdict) ;|NOXLATE,p300f|;"ACAD_GROUP"))
;grpdict是包含所有group内容的容器
(setq grpnew grpdict)
(if (not (null grpdict))
(foreach item grpdict ;start of foreach
(progn ; progn 1
(if (= (car item) 3); if 2
(progn ; progn 2
(setq name (cdr item ))
(if (Hasent grpdict name); if 3
(progn; progn 3
(if (not gromeb)
(progn
(entdel (cdadr (member item grpnew)))
(setq count2 (+ count2 1))
)
)
) ;end of progn 3
(progn
(entdel (cdadr (member item grpnew)))
(setq count3 (+ count3 1))
)
) ; end of if 3
(setq count1 (+ count1 1))
) ;end of progn 2
) ;end of if 2
) ;end of progn 1
) ;end of foreach
)
(princ "\n")
(princ count1)
(princ " groups member foung.\n")
(princ count2)
(princ " groups without objects have be cleaned.\n")
(princ count3)
(princ " groups without listed have be cleaned.\n")
(princ "\n")
(princ (- count1 count2 count3))
(princ " groups have be remened.\n")
(setvar ;|NOXLATE|;"tilemode" tilemode0)
(setvar ;|NOXLATE|;"cmdecho" echo0)
(setvar ;|NOXLATE|;"pickstyle" pick0)
(setq *error* old_error)
(princ)
)
;为了为了表达我对超级版主meflying最崇高的敬意和谢意，
;请所有使用了这个程序的人们别忘了感谢超级版主meflying
;的功劳，正是他使我摆脱了插入块中的废组名产生程序中断。
;如哪位大侠要对这个程序编制者表达谢意，请首先感谢
;超级版主meflying,最好对meflyinge有一定的物质感谢，毕竟
;人还是要有一定的爱心和现实主义。

无痕

好像写的长了些，看的我头晕

myfreemind

MEFLYING版主非常棒的！

ketxu

Thanks for sharing. Collected ^^

李钊伟2012

没看懂为何程序查快会奔溃