关于组group的相关函数

jxmjg · 发表于 2024-3-29 13:37:35

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

复制代码

jxmjg · 发表于 2024-3-29 13:37:52

;;;========================================================;
;;;取得图元所在的组名 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))
)
)
)
)
)
)
)

复制代码

jxmjg · 发表于 2024-3-29 13:38:16

;;制作匿名组
(defun c:mak采用*group (/ ss)
(princ "\n选取制作匿名组的对象:")
(if (setq ss (ssget))
(fsxm-add-group ss "*")
)
(princ)
)
;;解散群组
(defun C:EXPLODE采用GROUP (/ allg data group ss)
(if (setq ss (ssget))
(foreach en (fsxm-ss->enlist ss)
(setq data (entget en))
(setq group
(vl-remove-if
'(lambda (a)
(or (/= (car a) 330)
(/= (fsxm-getdxf 0 (entget (cdr a))) "GROUP")
)
)
data
)
)
(setq allg (reverse (dictsearch (namedobjdict) "ACAD采用GROUP")))
(foreach a (mapcar 'cdr group)
(princ "\nEXPLODE GROUP : ")
(princ (cdadr (member (cons 350 a) allg)))
(entdel a)
)
)
)
(princ)
)

复制代码

jxmjg · 发表于 2024-3-29 13:38:47

(defun c:gg(/ ss)
(setq ss(ssget))
(setvar "cmdecho" 0)
(command "-group" "" "*" "" ss "")
(setvar "cmdecho" 1)
(princ "\n选定对象已经组合。")
(princ)
)

复制代码

jxmjg · 发表于 2024-3-29 13:42:49

(if (setq s (ssget))
(progn
(repeat (setq n (sslength s))
(setq r (cons (ssname s (setq n (1- n))) r))
)
(vla-AppendItems
(vla-add (vla-get-groups
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"*" ;;创建无名组
)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length r)))
)
(mapcar 'vlax-ename->vla-object r)
)
)
)
)
)

复制代码

admin · 发表于 2024-3-29 22:43:41

(if (setq s (ssget))
(progn
(repeat (setq n (sslength s))
(setq r (cons (ssname s (setq n (1- n))) r))
)
(vla-AppendItems
(vla-add (vla-get-groups
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"*" ;;创建无名组
)
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbObject
(cons 0 (1- (length r)))
)
(mapcar 'vlax-ename->vla-object r)
)
)
)
)
)

复制代码

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

关于组group的相关函数

相关帖子