群组(group)-帮忙补充_子函数

alexmai

我在这里找到关于群组(group)的资料
http://bbs.xdcad.net/thread-712340-1-1.html，
发现缺失子函数_GROUPADDORDEL
有能力的大侠可否补上，谢谢！


快捷群组：

2. 
   
3. (vl-load-com)
   
4. (DEFUN c:GGG(/ E EL N SS)  
   
5.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
   
6.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
   
7.   ;;清理空组
   
8.   (C:DelEmptyGroup)  
   
9.   ;;显示当有组数量
   
10.   (princ (strcat "\n 当前有 "  (itoa (c:GroupsCount))  " 个组" ))
    
11.   ;;显示所有组名
    
12.   (princ (C:AllGroups))
    
13.   
    
14.   (_StartUndo *DOC*)
    
15.   (SETQ E (CAR (ENTSEL "\n 组[创建或增减成员/分解]<分解所有组>")))
    
16.   (if e
    
17.     (if        (_GROUPNAMES e);是组
    
18.       (_GroupAddOrDel e)
    
19.       ;;选择对象创建组
    
20.       (if (setq ss (LM:ssget "\n 选择对象创建无名组" nil))
    
21.         (progn
    
22.           (ssadd e ss)
    
23.           (IF (> (SSLENGTH SS) 1)
    
24.             (PROGN
    
25.               (repeat (setq n (sslength ss))
    
26.                 (setq eL (cons (ssname ss (setq n (1- n))) eL))
    
27.               )
    
28.               (_CreateGroup (mapcar 'vlax-ename->vla-object eL))
    
29.               (princ "\n 成功创建无名组")
    
30.             )
    
31.             (princ "\n 只有一个对象，不能创建组")
    
32.           )
    
33.         )
    
34.         (princ "\n 没有选择对象，不能创建组")
    
35.       )
    
36.     )
    
37.     ;;空选时, 分解有的组
    
38.     (C:DelAllGroups)
    
39.   )   
    
40.   (_EndUndo *DOC*)
    
41.   
    
42.   (gc)
    
43.   (princ "\n 组操作命令 GGG")
    
44.   (princ)
    
45. )
    
46. (princ "\n 组操作命令 GGG")
    
47. 
    
48. ;;1 带提示的ssget
    
49. (defun LM:ssget (msg arg / sel )
    
50.     (princ msg)
    
51.     (setvar 'nomutt 1)
    
52.     (setq sel (vl-catch-all-apply 'ssget arg))
    
53.     (setvar 'nomutt 0)
    
54.     (if (not (vl-catch-all-error-p sel)) sel)
    
55. )
    
56. ;;2 创建组
    
57. (defun _CreateGroup (Objlst)
    
58.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
59.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
60.   (vla-appenditems
    
61.     (vla-add (vla-get-groups *DOC*) "*")
    
62.     (vlax-make-variant
    
63.       (vlax-safearray-fill
    
64.         (vlax-make-safearray
    
65.           vlax-vbobject
    
66.           (cons 0 (1- (length objlst)))
    
67.         )
    
68.         objlst
    
69.       )
    
70.     )
    
71.   )
    
72. )
    
73. ;;3 统计组定义个数
    
74. (defun c:GroupsCount ()
    
75.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
76.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
77.   (vla-get-count (vla-get-groups *DOC*))
    
78. )
    
79. 
    
80. ;;4 删除所有组定义
    
81. (defun c:DelAllGroups ()
    
82.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
83.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
84.   (vlax-for obj        (vla-get-groups *DOC*)
    
85.     (vla-delete obj)
    
86.   )
    
87. )
    
88. 
    
89. ;;5 删除空组
    
90. (defun c:DelEmptyGroup        ()
    
91.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
    
92.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
    
93.   (vlax-for obj        (vla-get-groups *DOC*)
    
94.     (if        (< (vla-get-count obj) 2)
    
95.       (vla-delete obj)
    
96.     )
    
97.   )
    
98. )
    
99. 
    
100. ;;7 求所有组名 -> ("*A1" "*A2" "2")
     
101. (defun C:AllGroups (/ LST)
     
102.   (setq lst (dictsearch (namedobjdict) "ACAD_GROUP"))
     
103.   (mapcar 'cdr
     
104.           (vl-remove-if '(lambda (x) (/= (car x) 3)) lst)
     
105.   )
     
106. )
     
107. ;;8 实体所在组名 => ("*A4")
     
108. ;;(_GROUPNAMES (car(entsel)))
     
109. (defun _GROUPNAMES (ENAME / KEY DICT RESULT)
     
110.   (setq        KEY  (cons 340 ENAME)
     
111.         DICT (dictsearch (namedobjdict) "acad_group")
     
112.   )
     
113.   (while (setq DICT (member (assoc 3 DICT) DICT))
     
114.     (if        (member KEY (entget (cdadr DICT)))
     
115.       (setq RESULT (cons (cdar DICT) RESULT))
     
116.     )
     
117.     (setq DICT (cddr DICT))
     
118.   )
     
119.   (reverse RESULT)
     
120. )
     
121. 
     
122. ;;9 分解特定组名的组
     
123. ;;(_DelOneGroup "*A4")
     
124. (defun _DelOneGroup (N)
     
125.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
     
126.   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
     
127.   (vlax-for obj        (vla-get-groups *DOC*)
     
128.     (if        (= (vla-get-name obj) N)
     
129.       (vla-delete obj)
     
130.     )
     
131.   )
     
132. )

<br /> (vl-load-com)<br /> (DEFUN c:GGG(/ E EL N SS)  <br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   ;;清理空组<br />   (C:DelEmptyGroup)  <br />   ;;显示当有组数量<br />   (princ (strcat "\n 当前有 "  (itoa (c:GroupsCount))  " 个组" ))<br />   ;;显示所有组名<br />   (princ (C:AllGroups))<br />   <br />   (_StartUndo *DOC*)<br />   (SETQ E (CAR (ENTSEL "\n 组[创建或增减成员/分解]<分解所有组>")))<br />   (if e<br />     (if        (_GROUPNAMES e);是组<br />       (_GroupAddOrDel e)<br />       ;;选择对象创建组<br />       (if (setq ss (LM:ssget "\n 选择对象创建无名组" nil))<br />         (progn<br />           (ssadd e ss)<br />           (IF (> (SSLENGTH SS) 1)<br />             (PROGN<br />               (repeat (setq n (sslength ss))<br />                 (setq eL (cons (ssname ss (setq n (1- n))) eL))<br />               )<br />               (_CreateGroup (mapcar 'vlax-ename->vla-object eL))<br />               (princ "\n 成功创建无名组")<br />             )<br />             (princ "\n 只有一个对象，不能创建组")<br />           )<br />         )<br />         (princ "\n 没有选择对象，不能创建组")<br />       )<br />     )<br />     ;;空选时, 分解有的组<br />     (C:DelAllGroups)<br />   )    <br />   (_EndUndo *DOC*)<br />   <br />   (gc)<br />   (princ "\n 组操作命令 GGG")<br />   (princ)<br /> )<br /> (princ "\n 组操作命令 GGG")<br /> <br /> ;;1 带提示的ssget<br /> (defun LM:ssget (msg arg / sel )<br />     (princ msg)<br />     (setvar 'nomutt 1)<br />     (setq sel (vl-catch-all-apply 'ssget arg))<br />     (setvar 'nomutt 0)<br />     (if (not (vl-catch-all-error-p sel)) sel)<br /> )<br /> ;;2 创建组<br /> (defun _CreateGroup (Objlst)<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (vla-appenditems<br />     (vla-add (vla-get-groups *DOC*) "*")<br />     (vlax-make-variant<br />       (vlax-safearray-fill<br />         (vlax-make-safearray<br />           vlax-vbobject<br />           (cons 0 (1- (length objlst)))<br />         )<br />         objlst<br />       )<br />     )<br />   )<br /> )<br /> ;;3 统计组定义个数<br /> (defun c:GroupsCount ()<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (vla-get-count (vla-get-groups *DOC*))<br /> )<br /> <br /> ;;4 删除所有组定义<br /> (defun c:DelAllGroups ()<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (vlax-for obj        (vla-get-groups *DOC*)<br />     (vla-delete obj)<br />   )<br /> )<br /> <br /> ;;5 删除空组<br /> (defun c:DelEmptyGroup        ()<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (vlax-for obj        (vla-get-groups *DOC*)<br />     (if        (< (vla-get-count obj) 2)<br />       (vla-delete obj)<br />     )<br />   )<br /> )<br /> <br /> ;;7 求所有组名 -> ("*A1" "*A2" "2") <br /> (defun C:AllGroups (/ LST)<br />   (setq lst (dictsearch (namedobjdict) "ACAD_GROUP"))<br />   (mapcar 'cdr<br />           (vl-remove-if '(lambda (x) (/= (car x) 3)) lst)<br />   )<br /> )<br /> ;;8 实体所在组名 => ("*A4")<br /> ;;(_GROUPNAMES (car(entsel)))<br /> (defun _GROUPNAMES (ENAME / KEY DICT RESULT)<br />   (setq        KEY  (cons 340 ENAME)<br />         DICT (dictsearch (namedobjdict) "acad_group")<br />   )<br />   (while (setq DICT (member (assoc 3 DICT) DICT))<br />     (if        (member KEY (entget (cdadr DICT)))<br />       (setq RESULT (cons (cdar DICT) RESULT))<br />     )<br />     (setq DICT (cddr DICT))<br />   )<br />   (reverse RESULT)<br /> )<br /> <br /> ;;9 分解特定组名的组<br /> ;;(_DelOneGroup "*A4")<br /> (defun _DelOneGroup (N)<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))<br />   (vlax-for obj        (vla-get-groups *DOC*)<br />     (if        (= (vla-get-name obj) N)<br />       (vla-delete obj)<br />     )<br />   )<br /> )

alexmai

群组的好处是，是可以和块(动态块)结合一起使用，检查和修改更方便
群组增加物体，群组减物体，炸特定组，全图删除组，点选显示组名
全搞定了，源码在明经和晓东找的，再总结组合，收个币

alexmai

群组，要配合快捷键使用，才有效率
类似word里的组合，常用地方： 引线+材料号，引线+文字，图框内容组合，列表组合....等等
ctrl + A   是群组的开关
不过要提前设置一下： cui  详细设置如下

http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTEyOTQ0fDU2YzNiMzQ4NjFiZmE0NGQ0MTI4YmY3YTc4YzYwZDllfDE3MTk5Njc5OTk%3D&request=yes&_f=.jpg
http://bbs.mjtd.com/forum.php?mod=attachment&aid=MTEyOTQ1fDRkODNiZWVlYjk1OGM1OThjN2NmNWIyZDI1NmE0YmEyfDE3MTk5Njc5OTk%3D&request=yes&_f=.jpg

设置后就可以完美使用： ctrl + A   群组开关

alexmai

lllllja 发表于 2019-3-28 15:17
有没有什么办法，可以往已有组里添加图素，像块一样的操作

组增加物体，组减物体，都已经有了

特别是组减物体，明经，晓东都找过了，也没找到好用的原码。

最后自己编的，但也有小毛病（第一次点选带动态块的组时，组是不认动态块的物体，点其它就没问题）

yoyoho

谢谢! alexmai 分享程序!!!!

lllllja

有没有什么办法，可以往已有组里添加图素，像块一样的操作

lllllja

alexmai 发表于 2019-3-29 08:46
组增加物体，组减物体，都已经有了

特别是组减物体，明经，晓东都找过了，也没找到好用的原码。

感谢回复，我再研究一下

依然小小鸟

alexmai 发表于 2019-3-29 08:46
组增加物体，组减物体，都已经有了

特别是组减物体，明经，晓东都找过了，也没找到好用的原码。

多个物体框选之后   能否批量各自成组   另外 组合物体 能否批量各自成组

alexmai

依然小小鸟 发表于 2019-3-29 09:01
多个物体框选之后   能否批量各自成组   另外 组合物体 能否批量各自成组

不能，只能单选一个组增加物体，多几个组一起点选，只会变为一个大组合

依然小小鸟

alexmai 发表于 2019-3-29 09:05
不能，只能单选一个组增加物体，多几个组一起点选，只会变为一个大组合

恩 希望大神攻克这个难关

ambox

谢谢分享，正需要