分享一个LEE-MAC大神的关于组group的相关函数

yjtdkj · 发表于 2021-8-1 20:42:23

本帖最后由 yjtdkj 于 2021-8-5 14:59 编辑

先上原帖地址https://www.theswamp.org/index.php?topic=49214.msg543280#msg543280
打不开地址的话，就看下面的代码(08.05更新，原代码有个小错误，少了330组码)

;; Group Entities - Lee Mac;; Creates a Group with a given name containing all entities in the supplied list
;; grp - [str] Group name (use "*" for an anonymous group)
;; lst - [lst] List of entities to add to group
;; sel - [bol] If T, group is selectable
(defun LM:groupentities ( grp lst sel / dic enx gde gdx tmp )
(if (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
(if (setq gdx (dictsearch dic grp)
gde (cdr (assoc -1 gdx))
)
(progn
(entmod (append gdx (mapcar '(lambda ( x ) (cons 340 x)) lst)))
(foreach ent lst
(setq enx (entget ent)
tmp (member '(102 . "{ACAD_REACTORS") enx)
)
(if tmp
(setq tmp
(vl-list*
(car tmp)
(cons 330 gde)
(cdr tmp)
)
)
(setq tmp
(vl-list*
'(102 . "{ACAD_REACTORS")
(cons 330 gde)
'(102 . "}")
(cdr (member (assoc 5 enx) enx))
)
)
)
(entmod (append (reverse (member (assoc 5 enx) (reverse enx))) tmp))
)
grp
)
(if
(and
(setq gde
(entmakex
(list
'(000 . "GROUP")
'(102 . "{ACAD_REACTORS")
(cons 330 dic)
'(102 . "}")
(cons 330 dic)
'(100 . "AcDbGroup")
(if (wcmatch grp "`*") '(070 . 1) '(070 . 0))
(if sel '(071 . 1) '(071 . 0))
)
)
)
(if (wcmatch grp "`*")
(if (entmod (append (entget dic) (list '(3 . "*") (cons 350 gde)))) ;; thanks vk/rjp
(setq grp
(cdadr
(member
(cons 350 gde)
(reverse (entget dic))
)
)
)
)
(dictadd dic grp gde)
)
)
(LM:groupentities grp lst sel)
)
)
)
)
(defun c:test ( / grp idx lst sel )
(while
(not
(or (wcmatch (setq grp (getstring t "Specify group name: ")) "`*,")
(snvalid grp)
)
)
(princ "\nGroup name invalid.")
)
(if (and (/= "" grp) (setq sel (ssget )))
(progn
(repeat (setq idx (sslength sel))
(setq lst (cons (ssname sel (setq idx (1- idx))) lst))
)
(LM:groupentities grp lst t)
)
)
)

;; Group Entities  -  Lee Mac;; Creates a Group with a given name containing all entities in the supplied list 
;; grp - [str] Group name (use "*" for an anonymous group) 
;; lst - [lst] List of entities to add to group 
;; sel - [bol] If T, group is selectable 
 
(defun LM:groupentities ( grp lst sel / dic enx gde gdx tmp ) 
    (if (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group")))) 
        (if (setq gdx (dictsearch dic grp) 
                  gde (cdr (assoc -1 gdx)) 
            ) 
            (progn 
                (entmod (append gdx (mapcar '(lambda ( x ) (cons 340 x)) lst))) 
                (foreach ent lst 
                    (setq enx (entget ent) 
                          tmp (member '(102 . "{ACAD_REACTORS") enx) 
                    ) 
                    (if tmp 
                        (setq tmp 
                            (vl-list* 
                                (car tmp) 
                                (cons 330 gde) 
                                (cdr tmp) 
                            ) 
                        ) 
                        (setq tmp 
                            (vl-list* 
                               '(102 . "{ACAD_REACTORS") 
                                (cons 330 gde) 
                               '(102 . "}") 
                                (cdr (member (assoc 5 enx) enx)) 
                            ) 
                        ) 
                    ) 
                    (entmod (append (reverse (member (assoc 5 enx) (reverse enx))) tmp))       
                ) 
                grp 
            ) 
            (if 
                (and 
                    (setq gde 
                        (entmakex 
                            (list 
                               '(000 . "GROUP") 
                               '(102 . "{ACAD_REACTORS") 
                               (cons 330 dic) 
                               '(102 . "}") 
                               (cons 330 dic) 
                               '(100 . "AcDbGroup") 
                                (if (wcmatch grp "`*") '(070 . 1) '(070 . 0)) 
                                (if sel                '(071 . 1) '(071 . 0)) 
                            ) 
                        ) 
                    ) 
                    (if (wcmatch grp "`*") 
                        (if (entmod (append (entget dic) (list '(3 . "*") (cons 350 gde)))) ;; thanks vk/rjp 
                            (setq grp 
                                (cdadr 
                                    (member 
                                        (cons 350 gde) 
                                        (reverse (entget dic)) 
                                    ) 
                                ) 
                            ) 
                        ) 
                        (dictadd dic grp gde) 
                    ) 
                ) 
                (LM:groupentities grp lst sel) 
            ) 
        ) 
    ) 
) 
(defun c:test ( / grp idx lst sel ) 
    (while 
        (not 
            (or (wcmatch (setq grp (getstring t "Specify group name: ")) "`*,") 
                (snvalid grp) 
            ) 
        ) 
        (princ "\nGroup name invalid.") 
    ) 
    (if (and (/= "" grp) (setq sel (ssget ))) 
        (progn 
            (repeat (setq idx (sslength sel)) 
                (setq lst (cons (ssname sel (setq idx (1- idx))) lst)) 
            ) 
            (LM:groupentities grp lst t) 
        ) 
    ) 
)

主要功能是创建组，但还有一些额外功能，如下：
1.如果已经存在同名的组，则以上将添加提供的实体到现有组。
2.以上将允许创建嵌套组 - 即包含已包含在其他组中的对象的组。
3.输入*号则可以创建匿名组

yjtdkj · 发表于 2021-8-1 20:47:25

再传一个我写的配套的函数，取得图元的组名

;;;========================================================;
;;;取得图元所在的组名 by yjtdkj2021.08.01;
;;;========================================================;
(defun GetEntGroupName (gpe / el lst a g gpnlst)
(setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
(setq el (entget gpe))
(if (setq lst (member '(102 . "{ACAD_REACTORS") el))
(while (and (setq lst (cdr lst)) (= 330 (car (setq a (car lst)))))
(if (= "GROUP"
(cdr (assoc 0 (entget (setq g (cdr a)))))
)
(setq grp
(cdadr
(member
(cons 350 g)
(reverse (entget dic))
)
)
)
)
)
)
)

tigcat · 发表于 2021-8-1 21:53:23

谢谢分享，组这个功能用的非常少。块倒是多一点

yoyoho · 发表于 2021-8-2 06:47:04

谢谢! yjtdkj 分享程序!!!!!!

yshf · 发表于 2021-8-2 07:39:41

谢谢分享

zilong136 · 发表于 2024-3-29 13:21:06

本帖最后由 zilong136 于 2024-3-29 13:31 编辑

就问命令是不是“test”?输完之后不能继续下一步的操作。

magicheno · 发表于 2024-3-29 23:01:49

感谢大佬分享

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

[源码] 分享一个LEE-MAC大神的关于组group的相关函数