[原创]：*千里追凶－－通过选组内实体求组定义组名*攻略

陌生人

千里追凶－－通过选组内实体求组定义组名
测试分析:

2. 
   
3.   (setq a (entget(car(entsel))))
   
4.   (setq a360 (entget(cdr(assoc 360 a))))
   
5.   ;->得实体词典定义.
   
6.   ;((-1 . <图元名: 7ef7cee8>) (0 . "DICTIONARY") (330 . <图元名: 7ef7cea8>) (5 . "A5") (100 . "AcDbDictionary")
   
7.   ;(280 . 1) (281 . 1))
   
8.   (setq b360 (entget(cdr(assoc 330 a360))))
   
9.   ;=> 与a相同!
   
10.   ;((-1 . <图元名: 7ef7cea8>) (0 . "LWPOLYLINE") (5 . "9D") (102 . "{ACAD_XDICTIONARY")
    
11.   ;(360 . <图元名: 7ef7cee8>) (102 . "}") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7cec0>) (102 . "}")
    
12.   ;(330 . <图元名: 7ef7cc10>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPolyline")
    
13.   ;(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)
    
14.   ;(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)
    
15.   ;(10 33990.7 7262.24) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))
    
16.   (setq a330 (entget(cdr(assoc 330 a))))
    
17.   ;->得组定义,但无组名字.
    
18.   ;((-1 . <图元名: 7ef7cec0>) (0 . "GROUP") (5 . "A0") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccc0>) (102 . "}")
    
19.   ;(330 . <图元名: 7ef7ccc0>) (100 . "AcDbGroup") (300 . "") (70 . 0) (71 . 1)
    
20.   ;(340 . <图元名: 7ef7ceb0>)(340 . <图元名: 7ef7ceb8>) (340 . <图元名: 7ef7cea8>)) ;;<-组包含的实体.
    
21.   (setq b330 (entget(cdr(assoc 330 a330))))
    
22.   ;->找到(3 . "XX")为所要找的组名.
    
23.   ;((-1 . <图元名: 7ef7ccc0>) (0 . "DICTIONARY") (5 . "18") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccd0>)
    
24.   ;(102 . "}") (330 . <图元名: 7ef7ccd0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "*A1")
    
25.   ;(350 . <图元名: 7ef7ced8>) (3 . "1") (350 . <图元名: 7ef7ce68>) (3 . "XX") (350 . <图元名: 7ef7cec0>))
    
26.   (setq groupname (cdr(car(cdr(member (cons 350 (cdr(assoc -1 a330))) (reverse b330))))))
    
27.   ;->"XX"

<br />   (setq a (entget(car(entsel))))<br />   (setq a360 (entget(cdr(assoc 360 a))))<br />   ;->得实体词典定义.<br />   ;((-1 . <图元名: 7ef7cee8>) (0 . "DICTIONARY") (330 . <图元名: 7ef7cea8>) (5 . "A5") (100 . "AcDbDictionary")<br />   ;(280 . 1) (281 . 1))<br />   (setq b360 (entget(cdr(assoc 330 a360))))<br />   ;=> 与a相同!<br />   ;((-1 . <图元名: 7ef7cea8>) (0 . "LWPOLYLINE") (5 . "9D") (102 . "{ACAD_XDICTIONARY")<br />   ;(360 . <图元名: 7ef7cee8>) (102 . "}") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7cec0>) (102 . "}")<br />   ;(330 . <图元名: 7ef7cc10>) (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (100 . "AcDbPolyline")<br />   ;(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)<br />   ;(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)<br />   ;(10 33990.7 7262.24) (40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))<br />   (setq a330 (entget(cdr(assoc 330 a))))<br />   ;->得组定义,但无组名字.<br />   ;((-1 . <图元名: 7ef7cec0>) (0 . "GROUP") (5 . "A0") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccc0>) (102 . "}")<br />   ;(330 . <图元名: 7ef7ccc0>) (100 . "AcDbGroup") (300 . "") (70 . 0) (71 . 1)<br />   ;(340 . <图元名: 7ef7ceb0>)(340 . <图元名: 7ef7ceb8>) (340 . <图元名: 7ef7cea8>)) ;;<-组包含的实体.<br />   (setq b330 (entget(cdr(assoc 330 a330))))<br />   ;->找到(3 . "XX")为所要找的组名.<br />   ;((-1 . <图元名: 7ef7ccc0>) (0 . "DICTIONARY") (5 . "18") (102 . "{ACAD_REACTORS") (330 . <图元名: 7ef7ccd0>)<br />   ;(102 . "}") (330 . <图元名: 7ef7ccd0>) (100 . "AcDbDictionary") (280 . 0) (281 . 1) (3 . "*A1")<br />   ;(350 . <图元名: 7ef7ced8>) (3 . "1") (350 . <图元名: 7ef7ce68>) (3 . "XX") (350 . <图元名: 7ef7cec0>))<br />   (setq groupname (cdr(car(cdr(member (cons 350 (cdr(assoc -1 a330))) (reverse b330))))))<br />   ;->"XX"

;结论:(注：以下方法仅对一重组有效，如实体同属于多个组，则运行结果对应最下层的组)
[php]
  ;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)))
)
[/php]
转贴其它资料及方法:

2. 
   
3. ;求组名其它方法－－－－from autocad讨论组.
   
4. ;(gnames (car(entsel))) -> ("XX")
   
5. ;|Reply From: Piercey, Jason
   
6. Date: May/01/01 - 14:41 (GMT)
   
7. Re: Get the name of a group
   
8. |;
   
9. (defun gnames (ename / key dct rtn)
   
10.   (setq        key (cons 340 ename)
    
11.         dct (dictsearch (namedobjdict) "acad_group")
    
12.   )
    
13.   (while (setq dct (member (assoc 3 dct) dct))
    
14.     (if        (member key (entget (cdadr dct)))
    
15.       (setq rtn (cons (cdar dct) rtn))
    
16.     )
    
17.     (setq dct (cddr dct))
    
18.   )
    
19.   (reverse rtn)
    
20. )
    
21. ;|Re: Get the name of a group
    
22. Hi jbryant4
    
23. For A2k try following:
    
24. ;
    
25. ; -- Function VxGetGroupNames
    
26. ; Returns a list of all Group name(s) of the object.
    
27. ; Copyright:
    
28. ; &#169;2001 MENZI ENGINEERING GmbH, Switzerland
    
29. ; Arguments [Typ]:
    
30. ; Obj = Object [VLA-OBJECT]
    
31. ; Return [Typ]:
    
32. ; > Group name(s) [LIST]
    
33. ; Notes:
    
34. ; Use a DrawingReactor with a 'vlr-beginClose'-event to
    
35. ; release the Gb:AcO and Gb:AcD objects at the end of a
    
36. ; AutoCAD session - otherwise AutoCAD maybe crashes...
    
37. |;
    
38. (defun VxGetGroupNames (Obj / Cur_ID NmeLst)
    
39.   (setq        Gb:AcO (cond (Gb:AcO)
    
40.                      (T (vlax-get-acad-object))
    
41.                )
    
42.         Gb:AcD (cond (Gb:AcD)
    
43.                      (T (vla-get-activedocument Gb:AcO))
    
44.                )
    
45.         Cur_ID (vla-get-ObjectID Obj)
    
46.   )
    
47.   (vlax-for Grp        (vla-get-Groups Gb:AcD)
    
48.     (vlax-for Ent Grp
    
49.       (if (equal (vla-get-ObjectID Ent) Cur_ID)
    
50.         (setq NmeLst (cons (vla-get-Name Grp) NmeLst))
    
51.       )
    
52.     )
    
53.   )
    
54.   (reverse NmeLst)
    
55. )
    
56. 
    
57. ;Use:
    
58. (if (setq CurEnt (car (entsel)))
    
59.   (progn
    
60.     (setq CurObj (vlax-ename->vla-object CurEnt)
    
61.           GrpLst (VxGetGroupNames CurObj)
    
62.     )
    
63.   )
    
64. )

<br /> ;求组名其它方法－－－－from autocad讨论组.<br /> ;(gnames (car(entsel))) -> ("XX")<br /> ;|Reply From: Piercey, Jason <br /> Date: May/01/01 - 14:41 (GMT) <br /> Re: Get the name of a group<br /> |;<br /> (defun gnames (ename / key dct rtn)<br />   (setq        key (cons 340 ename)<br />         dct (dictsearch (namedobjdict) "acad_group")<br />   )<br />   (while (setq dct (member (assoc 3 dct) dct))<br />     (if        (member key (entget (cdadr dct)))<br />       (setq rtn (cons (cdar dct) rtn))<br />     )<br />     (setq dct (cddr dct))<br />   )<br />   (reverse rtn)<br /> )<br /> ;|Re: Get the name of a group<br /> Hi jbryant4<br /> For A2k try following:<br /> ;<br /> ; -- Function VxGetGroupNames<br /> ; Returns a list of all Group name(s) of the object.<br /> ; Copyright:<br /> ; &#169;2001 MENZI ENGINEERING GmbH, Switzerland<br /> ; Arguments [Typ]:<br /> ; Obj = Object [VLA-OBJECT]<br /> ; Return [Typ]:<br /> ; > Group name(s) [LIST]<br /> ; Notes:<br /> ; Use a DrawingReactor with a 'vlr-beginClose'-event to<br /> ; release the Gb:AcO and Gb:AcD objects at the end of a<br /> ; AutoCAD session - otherwise AutoCAD maybe crashes...<br /> |; <br /> (defun VxGetGroupNames (Obj / Cur_ID NmeLst)<br />   (setq        Gb:AcO (cond (Gb:AcO)<br />                      (T (vlax-get-acad-object))<br />                )<br />         Gb:AcD (cond (Gb:AcD)<br />                      (T (vla-get-activedocument Gb:AcO))<br />                )<br />         Cur_ID (vla-get-ObjectID Obj)<br />   )<br />   (vlax-for Grp        (vla-get-Groups Gb:AcD)<br />     (vlax-for Ent Grp<br />       (if (equal (vla-get-ObjectID Ent) Cur_ID)<br />         (setq NmeLst (cons (vla-get-Name Grp) NmeLst))<br />       )<br />     )<br />   )<br />   (reverse NmeLst)<br /> )<br /> <br /> ;Use:<br /> (if (setq CurEnt (car (entsel)))<br />   (progn<br />     (setq CurObj (vlax-ename->vla-object CurEnt)<br />           GrpLst (VxGetGroupNames CurObj)<br />     )<br />   )<br /> )

[/code]

maplesu

终于有一些头绪了！！

陌生人

如果反映良好，下次再贴for 求多重组信息的
[php]
;|
求组信息:
(getgp gpe)
返回: (list (组名 组定义实体名 组内实体)...) 列表.支持多重组.
       最下层的组(先定义的)在表的前面,最上层的组(后定义的)在表的后面.
测试:(getgp (car(entsel)))  ->
(("1" <图元名: 7ef7ce68> (<图元名: 7ef7ce58> <图元名: 7ef7ce60>))
("2" <图元名: 7ef7cf20> (<图元名: 7ef7ce58> <图元名: 7ef7ce60> <图元名: 7ef7cef8>))
)
|;
[/php]

maplesu

关于组的也是这两天才发现的
这样可以把图元设定一定的联系，而每个有可以单独操作
所以我也是在努力研究组。

eachy

http://www.xdcad.net/forum/showthread.php?threadid=127718
另外贴个XD工具箱中的函数
[PHP]
;|
   根据一个实体，活动实体属于组的组名
|;
(defun $xdlsp_entity_groupname (e / e1 e2 tf tf1 ss i el owner)
  (xdrx_setenttodb e)
  (if (setq e1 (xdrx_getentdxf 330))
    (progn
      (xdrx_setenttodb e1)
      (setq owner (xdrx_getentdxf 330))
      (while (setq e2 (xdrx_getentdxf 340 t))
        (setq el (cons e2 el))
      )
      (xdrx_setenttodb owner)
      (setq tf t)
      (while (and
               tf
               (setq na (xdrx_getentdxf 3 t))
             )
        (if (setq ss (xdrx_group->pickset na))
          (progn
            (setq tf1 t)
            (setq i -1)
            (while (and
                     tf1
                     (< i (1- (length el)))
                   )
              (if (not (ssmemb (nth (setq i (1+ i))
                                    el
                               ) ss
                       )
                  )
                (setq tf1 nil)
              )
            )
            (if tf1
              (setq tf nil)
            )
          )
        )
      )
    )
  )
  na
)[/PHP]

灯火

最初由 eachy 发布
[B]http://www.xdcad.net/forum/showthread.php?threadid=127718
另外贴个XD工具箱中的函数
[PHP]
;|
   根据一个实体，活动实体属于组的组名
|;
(defun $xdlsp_entity_groupname (e / e1 e2 tf tf1 s... [/B]

上面连接中讲的函数如何得到实体所属组名还请明示。

原贴函数如下：

;;测试实体所属组名
(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
)

eachy

返回的 g 就是实体所属的 所有组名，按所属组的层次排列。

灯火

借鉴陌生人和eachy的讨论，用如下函数可以获得实体所在的组名表，这样就可以避免遍历组词典用ObjectID比较了。
[PHP];;;=======================================================;
;;;计算实体所在的组名表                             ;
;;;========================================================;
(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)
)
[/PHP]

snsj

灯火兄你的程序对嵌套组得到的是NIL，不知道不用遍历对处理嵌套组有没有什么好办法，VLA的方法陌生人的最后一个精简下:
[php]
(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))
        )))(princ kj)(princ)
  )
[/php]

灯火

To  snsj

你说嵌套组是不是组包含组？试过了，可以计算实体所在的组名表。
或者，把问题在描述详细点。

陌生人

我试了灯火那个是可以的，另外返回值我还是喜欢这样：
(defun c:tt (/ en)
  (setq en (car (entsel)))
  (GetEntGroupName en)
)

(princ kj)(princ)＝》kj

snsj

可能是刚才测试的问题，现在好了，仔细看了灯火兄的程序，真是受益非浅
另能否赐教：caar   caaar    caaar   caaaar
                       cdar    cdaar    cdaaar
的用法，这些函数在HELP里没有解释，谢谢

灯火

最初由 snsj 发布
[B]可能是刚才测试的问题，现在好了，仔细看了灯火兄的程序，真是受益非浅
另能否赐教：caar   caaar    caaar   caaaar
                       cdar    cdaar    cdaaar
的用法，这些函数在HELP里没有解释，谢谢 [/B]

没仔细看help吧？

陌生人

最初由 灯火 发布
[B]借鉴陌生人和eachy的讨论，用如下函数可以获得实体所在的组名表，这样就可以避免遍历组词典用ObjectID比较了。
;;;=======================================================;
;;;计算实体所在的组名表      ... [/B]

这是我以前写的，一起共勉：）
[php]
;; gpn2 = 求实体所属组名列表--------------------------------------陌生人.2004.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))))))
            (setq gpnlst (cons (vla-get-Name (vlax-ename->vla-object g) ) gpnlst))
        )                                                         
      )
  )(reverse gpnlst)
)
[/php]

JOSDENNIS

嘩, 這些代碼足以嚇倒我. 想不到組應用的程序還有這樣的多. 發個貼請教各位版主. 可不可以實現自動找出嵌套组, 然后把嵌套组分解去再把這些分解后嵌套组的實體重新組成一個組呢.  我表達的意思不太明了. 還望各位可以理解.