编组 Group

/db_自贡黄明儒_ · 发表于 2017-9-12 10:05:52

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

关于组，如下两个界面。在高版本2016下界面也没有了，不知道桌子公司是想推广组，还是想忽略它，16下操作确实简单多了。
08下使用，确实功能丰富，不过也是很麻烦的。比如想分解一个组，先要找到组名，然后再分解。我是希望再图选择组，就分解它，这样就省事了。

通过两次选择，可实现如下功能
;;1 清理空组
;;2 创建无名组
;;3 分解所有组
;;4 组增加成员
;;5 组删除成员
;;6 显示组名
;;7 显示组数量
;;8 实体所在组名
;;9 分解特定组名的组
;;10 合并组
这样直接操作对象，比08方便多了。

/db_自贡黄明儒_ · 发表于 2017-9-12 10:07:16

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

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

fangmin723 · 发表于 2017-9-12 13:00:40

本帖最后由 fangmin723 于 2017-9-12 13:01 编辑

非常感谢黄大师的分享，但是内部缺少几个自定义函数
_EndUndo *DOC*、_GroupAddOrDel、_StartUndo

yjch · 发表于 2017-9-12 14:13:39

非常感谢，好好学习天天向上

liunian0524 · 发表于 2017-9-12 17:46:05

本帖最后由 liunian0524 于 2017-9-15 17:54 编辑

感谢黄大师分享,组有什么用,是方便选择吗.实际作图中我一直没用过它今天看了下组功能,确实方便,比块方便修改,CAD2018如图命令:classicgroup
QQ截图20170915175300.jpg

sicky111 · 发表于 2017-9-13 00:35:43

学习一下。

dnbcgrass · 发表于 2017-9-13 08:24:18

回复学习学习！

明天你好 · 发表于 2017-10-13 08:54:47

黄大师，没有GroupAddOrDel这个函数啊

wkq004 · 发表于 2017-12-15 20:31:49

重申.那位能快速建组呀.就是GROUP
http://bbs.mjtd.com/forum.php?mo ... &fromuid=285366
(出处: 明经CAD社区)

fsxm大侠作品12楼

麥芒HFD · 发表于 2018-3-9 23:02:22

不错不错，赞一个。。。。。。。。。。。。。

账号		自动登录	找回密码
密码			立即注册

[研讨] 编组 Group

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分