当年研究 “组” group 的手稿，有部分是网上资料，已注明
;;组定义函索测试---------------------------------lxx.2004.2
;统计组定义个数. ok
(defun c:countgp ()
(vla-get-count (vla-get-groups (vla-get-activedocument(vlax-get-acad-object))))
)
;删除所有组定义. ok
(defun c:delgps ()
(vlax-for obj (vla-get-groups (vla-get-activedocument(vlax-get-acad-object)))
(vla-delete obj)
)
)
;删除空组及数量为1的组定义. oklxx.2005.10改.
(defun c:delgp0 ()
(vlax-for obj (vla-get-groups (vla-get-activedocument(vlax-get-acad-object)))
(if (< (vla-get-count obj)2)(vla-delete obj))
)
)
;删除匿名组. oklxx.2005.10.
(defun c:del*gp ()
(vlax-for obj (vla-get-groups (vla-get-activedocument(vlax-get-acad-object)))
(if (wcmatch (vla-get-name obj)"'**")(vla-delete obj))
)
)
;组定义添加实体.
(defun c:gpadd ()
(setq doc (vla-get-activedocument(vlax-get-acad-object))
gp(entsel "\n选择要添加实体的组:")
(vlax-for obj (vla-get-activeselectionset doc)(vla-get-groups doc)
(vla-delete obj)
)
)
;所有组定义列表 ok
(defun c:listgps (/ gphd)
(vlax-for obj (vla-get-groups (vla-get-activedocument(vlax-get-acad-object)))
;(setq gphd (append gphd (list (vla-get-handle obj))))
(print (entget (handent (vla-get-handle obj))))
)
;(mapcar '(lambda (x) (print (entget (handent x))) (print)) gphd)
(princ)
)
;所有可选择的组名列表 ok
;组可选标志: dxf70 =3?
(defun c:gpsel (/ gps)
(vlax-for obj (vla-get-groups (vla-get-activedocument(vlax-get-acad-object)))
(if ;(/= 3 (cdr (assoc 70 (entget (vlax-vla-object->ename obj))))); ok too
(/= 3 (cdr (assoc 70 (entget (handent(vla-get-handle obj))))));ok
(setq gps (append gps(list (vla-get-name obj))))
)
)gps
)
;列出所选物体的组定义.;失败，废弃.
(defun c:selgp ()
(setq obj (vlax-ename->vla-object (car(entsel "\n列出组定义－－选择组:"))))
(setq obj2 (vla-GetExtensionDictionary obj)) ;;此处似乎不够严谨?
(if (= "AcDbDictionary" (vla-get-objectname obj2))
(print (entget (handent (vla-get-handle obj2))))
)
)
;取得所选物体的所在组名.;失败，废弃.
(defun c:selgpname ()
(setq obj (vlax-ename->vla-object (car(entsel "\n列出组定义－－选择组:"))))
(setq obj2 (vla-GetExtensionDictionary obj)) ;;此处似乎不够严谨?
(if (= "AcDbDictionary" (vla-get-objectname obj2))
(vla-get-name obj2)
)
)
(vla-get-objectname(vla-GetExtensionDictionary (vlax-ename->vla-object (car(entsel)))))
(setq a (entget(car(entsel))))
(setq a360 (entget(cdr(assoc 360 a))))
;->得实体词典定义.
;((-1 . <图元名: 7ef7cee8>) (0 . "DICTIONARY") (330 . <图元名: 7ef7cea8>) (5 . "A5") (100 . "AcDbDictionary")
;(280 . 1) (281 . 1))
(setq b360 (entget(cdr(assoc 330 a360))))
;=> 与a相同!
;((-1 . <图元名: 7ef7cea8>) (0 . "LWPOLYLINE") (5 . "9D") (102 . "{ACAD_XDICTIONARY")
;(360 . <图元名: 7ef7cee8>) (102 . "}") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7cec0>) (102 . "}")
;(330 . <图元名: 7ef7cc10>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPolyline")
;(90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 33990.7 14713.5) (40 . 0.0) (41 . 0.0) (42 . 0.0)
;(10 42287.1 14713.5) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 42287.1 7262.24) (40 . 0.0) (41 . 0.0) (42 . 0.0)
;(10 33990.7 7262.24) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
(setq a330 (entget(cdr(assoc 330 a))))
;->得组定义,但无组名字.
;((-1 . <图元名: 7ef7cec0>) (0 . "GROUP") (5 . "A0") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccc0>) (102 . "}")
;(330 . <图元名: 7ef7ccc0>) (100 . "AcDbGroup") (300 . "") (70 . 0) (71 . 1)
;(340 . <图元名: 7ef7ceb0>)(340 . <图元名: 7ef7ceb8>) (340 . <图元名: 7ef7cea8>)) ;;<-组包含的实体.
(setq b330 (entget(cdr(assoc 330 a330))))
;->找到(3 . "XX")为所要找的组名.
;((-1 . <图元名: 7ef7ccc0>) (0 . "DICTIONARY") (5 . "18") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccd0>)
;(102 . "}") (330 . <图元名: 7ef7ccd0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "*A1")
;(350 . <图元名: 7ef7ced8>) (3 . "1") (350 . <图元名: 7ef7ce68>) (3 . "XX") (350 . <图元名: 7ef7cec0>))
(setq groupname (cdr(car(cdr(member (cons 350 (cdr(assoc -1 a330))) (reverse b330))))))
;->"XX"
;结论:
;//////////////////////////////////////////////////////////////////////////////////////////////
;************************(仅仅for 一重的组名)--------------lxx.2004.5 ok!!
;1.求组定义:
;测试: (gpdef (car(entsel)))
(defun gpdef (gpe)
(entget(cdr(assoc 330 (entget gpe))))
)
;2.求组内实体:
;测试:返回-> (<图元名: 7ef7ceb0> <图元名: 7ef7ceb8> <图元名: 7ef7cea8>)
(mapcar 'cdr (vl-remove-if '(lambda(x)(/= 340 (car x))) (gpdef (car(entsel)))))
;3.求组名:
;测试:返回组名-> "xx"
(setq gpdefl (gpdef (car(entsel)))
gpdict (entget(cdr(assoc 330 gpdefl)))
gpname (cdadr(member (cons 350 (cdr(assoc -1 gpdefl))) (reverse gpdict)))
)
;//////////////////////////////////////////////////////////////////////////////////////////////
;//////////////////////////////////////////////////////////////////////////////////////////////
;|************************(for 任意重的组名)--------------lxx.2004.5 ok!!
;1.求组定义列表 -> (组定义1 组定义2 ...):
;测试: (gpdef (car(entsel)))
|;
(defun gpdef (gpe / el lst a gpdf gplst)
(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 (setq gpdf (entget(cdr a))))))
(setq gplst (cons gpdf gplst))
)
)
)(reverse gplst)
)
;|
(getgp gpe) = 求组信息--------------------------------------lxx.2004.5 ok!!
返回: (list (组名 组定义实体名 组内实体)...) 列表.支持多重组.
最下层的组(先定义的)在表的前面,最上层的组(后定义的)在表的后面.
测试:(getgp (car(entsel)))->
(("1" <图元名: 7ef7ce68> (<图元名: 7ef7ce58> <图元名: 7ef7ce60>))
("2" <图元名: 7ef7cf20> (<图元名: 7ef7ce58> <图元名: 7ef7ce60> <图元名: 7ef7cef8>))
)
|;
(defun getgp (gpe /)
(mapcar '(lambda(x)
(setq gpent(cdr(assoc -1 x))
gpelst (mapcar 'cdr (vl-remove-if '(lambda(x)(/= 340 (car x))) x))
gpdict (entget(cdr(assoc 330 x)))
gpname (cdadr(member (cons 350 gpent) (reverse gpdict))))
(list gpname gpent gpelst)
)
(gpdef gpe);;;调用gpdef.
)
)
;;; 如果是仅仅取得组名列表:
;; gpn = 求实体所属组名列表--------------------------------------lxx.2004.5 ok!!
;; (gpn (car(entsel))) -> ("X1" "X2" "TT")
(defun gpn (gpe / el lst a gpdf gps gpname gpnlst)
(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 (setq gpdf (entget(cdr a))))))
(setq gps (if gps gps(entget(cdr(assoc 330 gpdf))))
gpname (cdadr (member (cons 350 (cdr(assoc -1 gpdf))) (reverse gps)))
gpnlst (cons gpname gpnlst))
)
)
)(reverse gpnlst)
)
;; gpn程序 if部分用 vla方法取组名:
;; gpn2 = 求实体所属组名列表--------------------------------------lxx.2004.5 ok!!
;; (gpn2 (car(entsel))) -> ("X1" "X2" "TT")
(defun gpn2 (gpe / el lst a g gpnlst)
(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))))))
;或者: (= "AcDbGroup"(vla-get-objectName (setq gobj (vlax-ename->vla-object (cdr a)))))
(setq gpnlst (cons (vla-get-Name (vlax-ename->vla-object g ;| 或者gobj |;) ) gpnlst))
)
)
)(reverse gpnlst)
)
;//////////////////////////////////////////////////////////////////////////////////////////////
;//////////////////////////////////////////////////////////////////////////////////////////////
;;=====================================================================
;求组名其它方法－－－－ from autocad讨论组. snsj 修改 ok!
;返回: ("X2" "X1")
(defun objid (vla) (vla-get-objectid vla))
(defun c:test (/ doc theobj grp obj kj ip)
(setq doc (vla-get-Activedocument (vlax-get-acad-object)))
(vla-getentity
(vla-get-utility doc)
'theobj
'ip
"\nSelect Object: "
)
(vlax-for grp (vla-get-groups doc)
(vlax-for obj grp
(if (equal (objid obj) (objid theobj))
(setq kj (cons (vla-get-name grp) kj))
)
)
)kj
)
;;;
;;=====================================================================
;;获取实体的永久反应器 --- by eachy
(defun get_object_reactor (e / elst lst etlst)
(setq elst (entget e))
(if (and (assoc 102 elst)
(= (cdr (assoc 102 elst)) "{ACAD_REACTORS")
)
(progn
(setq lst (cdr (member '(102 . "{ACAD_REACTORS") elst)))
(while (= (caar lst) 330)
(setq etlst (cons (cdar lst) etlst))
(setq lst (cdr lst))
)
)
)
etlst
)
;应用示例一
;;测试实体所属组名
(defun test (lst / g)
(foreach item (mapcar 'vlax-ename->vla-object lst)
(if (= (vla-get-objectname item) "AcDbGroup")
(setq g (cons (vla-get-name item) g)
)
)
)
g
)
;;;同下列:获取实体的永久反应器 --by lucas
;(acet-acadreactor-ids-get (car (entsel))) ;在R2004+ defined "acetutil4.fas"
;;=====================================================================
;;;========================================================;
;;;计算实体所在的组名表 by 灯火;
;;;========================================================;
(defun GetEntGroupName (eName / DXF102 ELIST EN ET GPNAME OBJGROPU)
(setq dxf102 (assoc 102 (entget eName)))
(if (and dxf102 (= (cdr dxf102) "{ACAD_REACTORS"))
(progn
(setq eList (cdr (member '(102 . "{ACAD_REACTORS") (entget eName))))
(while (= (caar eList) 330)
(setq en (cdar eList))
(setq et (cdr (assoc 0 (entget en))))
(if (= et "GROUP")
(progn
(setq objGropu (vlax-ename->vla-object en))
(setq gpName (cons (vla-get-Name objGropu) gpName))
)
)
(setq eList (cdr eList))
)
)
)
gpName
)
;;测试
(defun c:tt (/ en)
(setq en (car (entsel)))
(princ (GetEntGroupName en))
(princ)
)
;;=====================================================================
;//////////////////////////////////////////////////////////////////////////////////////////////
;求组名其它方法－－－－from autocad讨论组.
;(gnames (car(entsel))) -> ("XX")
;|Reply From: Piercey, Jason
Date: May/01/01 - 14:41 (GMT)
Re: Get the name of a group
|;
(defun gnames (ename / key dct rtn)
(setq key (cons 340 ename)
dct (dictsearch (namedobjdict) "acad_group")
)
(while (setq dct (member (assoc 3 dct) dct))
(if (member key (entget (cdadr dct)))
(setq rtn (cons (cdar dct) rtn))
)
(setq dct (cddr dct))
)
(reverse rtn)
)
;|Re: Get the name of a group
Hi jbryant4
For A2k try following:
;
; -- Function VxGetGroupNames
; Returns a list of all Group name(s) of the object.
; Copyright:
; ©2001 MENZI ENGINEERING GmbH, Switzerland
; Arguments :
; Obj = Object
; Return :
; > Group name(s)
; Notes:
; Use a DrawingReactor with a 'vlr-beginClose'-event to
; release the Gb:AcO and Gb:AcD objects at the end of a
; AutoCAD session - otherwise AutoCAD maybe crashes...
|;
(defun VxGetGroupNames (Obj / Cur_ID NmeLst)
(setq Gb:AcO (cond (Gb:AcO)
(T (vlax-get-acad-object))
)
Gb:AcD (cond (Gb:AcD)
(T (vla-get-activedocument Gb:AcO))
)
Cur_ID (vla-get-ObjectID Obj)
)
(vlax-for Grp (vla-get-Groups Gb:AcD)
(vlax-for Ent Grp
(if (equal (vla-get-ObjectID Ent) Cur_ID)
(setq NmeLst (cons (vla-get-Name Grp) NmeLst))
)
)
)
(reverse NmeLst)
)
;Use:
(if (setq CurEnt (car (entsel)))
(progn
(setq CurObj (vlax-ename->vla-object CurEnt)
GrpLst (VxGetGroupNames CurObj)
)
)
)
;;; 求所有组名.
;;; (dictsearch(namedobjdict) "ACAD_GROUP") = 获得词典中所有组集合.
(setq lst (dictsearch(namedobjdict) "ACAD_GROUP")
gps (mapcar 'cdr (vl-remove-if '(lambda(x)(/= 3 (car x))) lst)))
;-> ("*A1" "*A2" "1" "22")
;|
命令: (dictsearch(namedobjdict) "ACAD_GROUP")
((-1 . <图元名: 7ef87cc0>) (0 . "DICTIONARY") (5 . "18") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef87cd0>)
(102 . "}") (330 . <图元名: 7ef87cd0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "1")
(350 . <图元名: 7ef87ef8>) (3 . "22") (350 . <图元名: 7ef87f00>))
(dictremove ename symbol)
功能及参数
此函数将在字典 ename 中删除一个 symbol 项目。
ename 参数是一个指定要寻找的字典图元名。而symbol参数则是要删除的关键名称。如果删除失败, 则系统将返回 nil。
若返回成功, 则系统会返回所删除的项目名称。
一般说来, dictremove函数并未真正自字典数据库中将指定项目删除(仅删除关键符号), 如要真正自数据库中删除,
请搭配 entdel 函数使用。
(dictremove (namedobjdict) "ACAD_GROUP")
((-1 . <图元名: 7ef87cc0>) (0 . "DICTIONARY") (5 . "18") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef87cd0>)
(102 . "}") (330 . <图元名: 7ef87cd0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "*A1")
(350 . <图元名: 7ef87f20>) (3 . "*A2") (350 . <图元名: 7ef87f40>) (3 . "1") (350 . <图元名: 7ef87ef8>)
(3 . "22") (350 . <图元名: 7ef87f00>))
|;
(entdel (cdr(assoc -1 (dictsearch (namedobjdict) "ACAD_GROUP")))) ;;->无效?!
(entmod (vl-remove-if '(lambda(x)(member (car x) '(3 350))) (dictsearch (namedobjdict) "ACAD_GROUP")));;->无效?!
;;炸开所有组定义.----by snsj .ok.
(defun c:exgp (/ obj)
(vl-load-com)
(vlax-for obj(vla-get-groups(vla-get-activedocument(vlax-get-acad-object)))
(vla-delete obj))
)
;;-----------------------------------------------------------------------
;;////////////////////////////////////////////////////////////////////////////////////
;; EACHY
;;(test (get_object_reactor (car (entsel))));
;;测试实体所属组名
(defun test (lst / g)
(foreach item (mapcar 'vlax-ename->vla-object lst)
(if (= (vla-get-objectname item) "AcDbGroup")
(setq g (cons (vla-get-name item) g)
)
)
)
g
)
;;获取实体的永久反应器
(defun get_object_reactor (e / elst lst etlst)
(setq elst (entget e))
(if (and (assoc 102 elst)
(= (cdr (assoc 102 elst)) "{ACAD_REACTORS")
)
(progn
(setq lst (cdr (member '(102 . "{ACAD_REACTORS") elst)))
(while (= (caar lst) 330)
(setq etlst (cons (cdar lst) etlst))
(setq lst (cdr lst))
)
)
)
etlst
)
;;-----------------------------------------------------------------------
;;/////////////////////////////////////////////////////////////////////////
;;GroupNames ( Ename )
;; Copyright c 2001 Michael Puckett - All Rights Reserved
;;Return a list of the group names the entity is a child of,
;;innermost first.
;;/////////////////////////////////////////////////////////////////////////
;;(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)
)
;;-----------------------------------------------------------------------
感谢大佬分享~ 谢谢楼主的分享
收藏了,下来学习领会
谢谢 谢谢楼主的分享
收藏了,下来学习领会
谢谢 感谢楼主分享学习心得 < 谢谢! > 谢谢你的辛劳和付出 cad里的group很少用的到，感觉这个命令只是一个壳！
感谢楼上的分享！ 谢谢这位大侠，如雷贯耳，支持一下！ 谢楼主的分享
收藏了,下来学习领会
谢谢!!!!!!!!!! 谢谢楼主分享 谢谢楼主分享