alexmai 发表于 2019-3-23 11:16:32

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

本帖最后由 alexmai 于 2019-3-23 11:28 编辑

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


快捷群组：

(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)
    )
)
)

alexmai 发表于 2019-3-23 17:13:50

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






alexmai 发表于 2021-4-18 16:59:24

本帖最后由 alexmai 于 2021-4-18 17:01 编辑

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

attach://112944.jpg
attach://112945.jpg

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

alexmai 发表于 2019-3-29 08:46:13

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

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

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

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

yoyoho 发表于 2019-3-24 14:46:28

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

lllllja 发表于 2019-3-28 15:17:17

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

lllllja 发表于 2019-3-29 09:01:33

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

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


感谢回复，我再研究一下

依然小小鸟 发表于 2019-3-29 09:01:57

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

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


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

alexmai 发表于 2019-3-29 09:05:02

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

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

依然小小鸟 发表于 2019-3-29 11:03:17

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

恩 希望大神攻克这个难关

ambox 发表于 2019-3-30 11:21:05

谢谢分享，正需要
页: [1] 2
查看完整版本: 群组(group)-帮忙补充_子函数