【组】空组删除

newer

空组就是组内没有实体的组，PURGE是处理不了的，因此写个代码处理下

1. (defun c:xdtb_grpdelempty (/ names grp)
   
2.   (xdrx-begin)
   
3.   (xdrx-object-get "group")
   
4.   (setq names nil)
   
5.   (while (setq grp (xdrx-object-next))
   
6.     (if        (xdrx-getpropertyvalue (cadr grp) "isEmpty")
   
7.       (progn (setq names (cons (car grp) names))
   
8.              (xdrx-object-delete (cadr grp))
   
9.       )
   
10.     )
    
11.   )
    
12.   (xdrx-prompt "\n共发现空组"
    
13.                (length names)
    
14.                "个"
    
15.                (if (> (length names) 0)
    
16.                  (strcat ",删除了" (xdrx-string-join names ","))
    
17.                  "."
    
18.                )
    
19.   )
    
20.   (xdrx-end)
    
21.   (princ)
    
22. )
    
23. 
    

(defun c:xdtb_grpdelempty (/ names grp)<br />   (xdrx-begin)<br />   (xdrx-object-get "group")<br />   (setq names nil)<br />   (while (setq grp (xdrx-object-next))<br />     (if        (xdrx-getpropertyvalue (cadr grp) "isEmpty")<br />       (progn (setq names (cons (car grp) names))<br />              (xdrx-object-delete (cadr grp))<br />       )<br />     )<br />   )<br />   (xdrx-prompt "\n共发现空组"<br />                (length names)<br />                "个"<br />                (if (> (length names) 0)<br />                  (strcat ",删除了" (xdrx-string-join names ","))<br />                  "."<br />                )<br />   )<br />   (xdrx-end)<br />   (princ)<br /> )<br /> <br />

再一种写法

1. (defun c:tt ()
   
2.   (xdrx-begin)
   
3.   (setq        db    (xdrx-database-select t)
   
4.         gdict (xdrx-getpropertyvalue db "groupdictionary")
   
5.         grps  (xdrx-getpropertyvalue gdict "allentries")
   
6.   )
   
7.   (mapcar '(lambda (x)
   
8.              (if (xdrx-getpropertyvalue (cadr x) "isEmpty")
   
9.                (progn (setq names (cons (car x) names))
   
10.                       (xdrx-object-delete (cadr x))
    
11.                )
    
12.              )
    
13.            )
    
14.           grps
    
15.   )
    
16. )
    
17. 
    

(defun c:tt ()<br />   (xdrx-begin)<br />   (setq        db    (xdrx-database-select t)<br />         gdict (xdrx-getpropertyvalue db "groupdictionary")<br />         grps  (xdrx-getpropertyvalue gdict "allentries")<br />   )<br />   (mapcar '(lambda (x)<br />              (if (xdrx-getpropertyvalue (cadr x) "isEmpty")<br />                (progn (setq names (cons (car x) names))<br />                       (xdrx-object-delete (cadr x))<br />                )<br />              )<br />            )<br />           grps<br />   )<br /> )<br /> <br />

ko05050

活到老学到老                    

pxr201419

好象在哪个贴上看到是这样的(vlax-for obj  (vla-get-groups (vla-get-ActiveDocument (vlax-get-acad-object)))
   (if (< (vla-get-count obj) 2)
      (vla-delete obj)))

Michael527

谢谢两位老师的分享！！！

z511367698

PU是不是也可以删除

feeling_chin

人很话不多，先点赞再说

feeling_chin

看到这个忽然想起来，
有没有可以清理空块的工具，
CAD较早版本都不支持清理。
谢谢了！