当年研究 “组” group 的手稿，有部分是网上资料，已注明

狂刀lxx · 发表于 2011-5-10 23:59:53

;;组定义函索测试---------------------------------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的组定义. ok lxx.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))
)
)
;删除匿名组. ok lxx.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 [Typ]:
; Obj = Object [VLA-OBJECT]
; Return [Typ]:
; > Group name(s) [LIST]
; 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)
)
;;-----------------------------------------------------------------------

;;组定义函索测试---------------------------------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的组定义. ok  lxx.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)) 
  ) 
) 
;删除匿名组. ok  lxx.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 <a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>讨论组. 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: 
; &#169;2001 MENZI ENGINEERING GmbH, Switzerland 
; Arguments [Typ]: 
; Obj = Object [VLA-OBJECT] 
; Return [Typ]: 
; > Group name(s) [LIST] 
; 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) 
) 
;;-----------------------------------------------------------------------

magicheno · 发表于 2022-5-20 22:56:24

感谢大佬分享~

461045462 · 发表于 2011-5-11 09:18:35

谢谢楼主的分享
收藏了,下来学习领会
谢谢

zhengchuan · 发表于 2011-5-20 01:33:02

谢谢楼主的分享
收藏了,下来学习领会
谢谢

yoyoho · 发表于 2011-5-20 07:42:47

感谢楼主分享学习心得 < 谢谢! >

yjc · 发表于 2011-5-20 14:04:57

谢谢你的辛劳和付出

啵浪鼓 · 发表于 2011-5-20 19:51:38

cad里的group很少用的到，感觉这个命令只是一个壳！
感谢楼上的分享！

jsdtzjm · 发表于 2011-5-26 11:20:48

谢谢这位大侠，如雷贯耳，支持一下！

mycad · 发表于 2011-6-2 10:41:58

谢楼主的分享
收藏了,下来学习领会
谢谢!!!!!!!!!!

T_T · 发表于 2011-6-5 01:55:33

谢谢楼主分享

skynoon · 发表于 2011-6-19 21:31:51

谢谢楼主分享

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

[讨论] 当年研究 “组” group 的手稿，有部分是网上资料，已注明

点评

评分

本帖被以下淘专辑推荐: