[分享]：entmake无名组

carrot1983

2. 
   
3.   [FONT=courier new]
   
4. ;;; ------------ CREATES UNAMED GROUP
   
5. (defun create_group (sslist / groupdictename entlist)
   
6.   (setq groupdictename (cdar (dictsearch (namedobjdict) "ACAD_GROUP")))
   
7.   (setq        entlist
   
8.          (append
   
9.            (list
   
10.              '(0 . "GROUP")
    
11.              '(102 . "{ACAD_REACTORS")
    
12.              (cons 330 groupdictename)
    
13.              '(102 . "}")
    
14.              '(100 . "AcDbGroup")
    
15.              '(300 . "I joist")                ; Description
    
16.              '(70 . 1)                        ; Named Group
    
17.              '(71 . 1)                        ; Selectable Group
    
18.            )
    
19.            (mapcar '(lambda (ent) (cons 340 ent)) sslist)
    
20.            ;; Add all ent from SSList to the group
    
21.          )
    
22.   )
    
23.   (entmake entlist)
    
24. )
    
25.   [/FONT]
    

<br />   [FONT=courier new]<br /> ;;; ------------ CREATES UNAMED GROUP<br /> (defun create_group (sslist / groupdictename entlist)<br />   (setq groupdictename (cdar (dictsearch (namedobjdict) "ACAD_GROUP")))<br />   (setq        entlist<br />          (append<br />            (list<br />              '(0 . "GROUP")<br />              '(102 . "{ACAD_REACTORS")<br />              (cons 330 groupdictename)<br />              '(102 . "}")<br />              '(100 . "AcDbGroup")<br />              '(300 . "I joist")                ; Description<br />              '(70 . 1)                        ; Named Group<br />              '(71 . 1)                        ; Selectable Group<br />            )<br />            (mapcar '(lambda (ent) (cons 340 ent)) sslist)<br />            ;; Add all ent from SSList to the group<br />          )<br />   )<br />   (entmake entlist)<br /> )<br />   [/FONT]<br />

秋枫

还是直接调用命令行创建方便。

狂刀

同感，没有必要花这么多精力。

eachy

俺都是这样用

2. 
   
3. (defun AddnGroup (Objlst)
   
4.   (vla-appenditems
   
5.     (vla-add (vla-get-groups
   
6.                (vla-get-activedocument (vlax-get-acad-object))
   
7.              )
   
8.              "*"
   
9.     )
   
10.     (vlax-make-variant
    
11.       (vlax-safearray-fill
    
12.         (vlax-make-safearray
    
13.           vlax-vbobject
    
14.           (cons 0 (1- (length objlst)))
    
15.         )
    
16.         objlst
    
17.       )
    
18.     )
    
19.   )
    
20. )
    
21. (defun c:t1 (/ ss ssl i e obj ol el)
    
22.   (if (setq ss (ssget))
    
23.     (progn
    
24.       (setq ssl        (sslength ss)
    
25.             i        -1
    
26.       )
    
27.       (repeat ssl (setq el (cons (ssname ss (setq i (1+ i))) el)))
    
28.       (addngroup (mapcar 'vlax-ename->vla-object el))
    
29.     )
    
30.   )
    
31. )

<br /> (defun AddnGroup (Objlst)<br />   (vla-appenditems<br />     (vla-add (vla-get-groups<br />                (vla-get-activedocument (vlax-get-acad-object))<br />              )<br />              "*"<br />     )<br />     (vlax-make-variant<br />       (vlax-safearray-fill<br />         (vlax-make-safearray<br />           vlax-vbobject<br />           (cons 0 (1- (length objlst)))<br />         )<br />         objlst<br />       )<br />     )<br />   )<br /> )<br /> (defun c:t1 (/ ss ssl i e obj ol el)<br />   (if (setq ss (ssget))<br />     (progn<br />       (setq ssl        (sslength ss)<br />             i        -1<br />       )<br />       (repeat ssl (setq el (cons (ssname ss (setq i (1+ i))) el)))<br />       (addngroup (mapcar 'vlax-ename->vla-object el))<br />     )<br />   )<br /> )

carrot1983

最初由 狂刀 发布
[B]同感，没有必要花这么多精力。 [/B]

同感。。。
是这个贴有人需要。。。
http://www.xdcad.net/forum/showthread.php?s=&threadid=656455

我的回复是：

命令: group
命令: -group 输入编组选项
[?/排序(O)/添加(A)/删除(R)/分解(E)/重命名(REN)/可选(S)/创建(C)] <创建>:
输入编组名或 [?]: *
输入编组的说明: *

开个帖是收函数库的。。。