查询实体的编组名

i-Stone

楼上这个只是获得组表.不能获得某一个图元所在组.

另:获得组表可以用组词典更方便.

7686599

  ★ fei-grp-getname:   (获取组名列表)                                              
       使用说明: (setq name (fei-grp-getname notifer))                              
       参    数: notifer = ename vla-object                                         
       返 回 值: 成功返回编组列表，失败返回nil  

(defun fei-grp-getname (notifer / *doc* *mspace* *pspace* a date n obj return)
  (and (cond ((equal (type notifer) 'ename)
       (setq obj notifer)
      )
      ((equal (type notifer) 'vla-object)
       (setq obj (vlax-vla-object->ename notifer))
      )
      (t
       (setq obj nil)
      )
       )
       (setq *doc* (vla-get-activedocument (vlax-get-acad-object)))
       (setq *mspace* (vla-get-modelspace *doc*))
       (setq *pspace* (vla-get-paperspace *doc*))
       (setq date (entget obj))
       (foreach x date
  (and (= (car x) 330)
       (setq a (vlax-ename->vla-object (cdr x)))
       (not (equal a *mspace*))
       (not (equal a *pspace*))
       (setq n (list (vla-get-name a)))
       (setq return (append return n))
  )
       )
  )
  return
)

i-Stone

还是组表.不行.

获得组表也不用这么麻烦.

如下:

(setq a '())
(vlax-for item (vla-get-groups
   (vla-get-activedocument (vlax-get-acad-object))
        )
  (setq a (append a (list (vla-get-name item))))
)

两句话就OK.

狂刀无痕

2. ;; gpn2 = 求实体所属组名列表--------------------------------------lxx.2004.5 ok!!
3. ;; (gpn2 (car(entsel))) -> ("X1" "X2" "TT")
4. (defun gpn2 (gpe / el lst a g gpnlst)
5.   (setq el (entget gpe))
6.   (if (setq lst (member '(102 . "{ACAD_REACTORS") el))
7.       (while (and(setq lst (cdr lst))(= 330 (car(setq a (car lst)))))
8. (if (= "GROUP" (cdr (assoc 0 (entget (setq g (cdr a))))))
9.      (setq gpnlst (cons (vla-get-Name (vlax-ename->vla-object g) ) gpnlst))
10. )                                                         
11.       )
12.   )(reverse gpnlst)
13. )

;; 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))))))      (setq gpnlst (cons (vla-get-Name (vlax-ename->vla-object g) ) gpnlst)) )                                                                )   )(reverse gpnlst) )

获得所有组名列表：
(setq lst (dictsearch(namedobjdict) "ACAD_GROUP")
        gps (mapcar 'cdr (vl-remove-if '(lambda(x)(/= 3 (car x))) lst)))

i-Stone

原来是这样.i see.

应在(setq el (entget gpe))前把gpnlst清空.

y01h

多谢各位这么热心，上午上不了网，急死我了，答案都仔细看了，一会儿试验去

y01h

各位还有个问题啊，怎么控制编组开关阿！

狂刀无痕

i-Stone发表于2007-8-16 12:56:00原来是这样.i see.应在(setq el (entget gpe))前把gpnlst清空.

gpnlst  已经写入内部参数列表。程序一开始就自动清空。这是lisp的默认处理。所以不必先来一句（setq gpnlst nil）画蛇添足。当然，加也没有错。

编组开关参 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=62251

i-Stone

ok.