分享一个LEE-MAC大神的关于组group的相关函数
本帖最后由 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 - Group name (use "*" for an anonymous group)
;; lst - List of entities to add to group
;; sel - 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.输入*号则可以创建匿名组
再传一个我写的配套的函数，取得图元的组名
;;;========================================================;
;;;取得图元所在的组名 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))
)
)
)
)
)
)
) 谢谢分享，组这个功能用的非常少。块倒是多一点 谢谢! yjtdkj 分享程序!!!!!! 谢谢分享 本帖最后由 zilong136 于 2024-3-29 13:31 编辑
就问命令是不是“test”?输完之后不能继续下一步的操作。 感谢大佬分享
页:
[1]