怎么创建带有属性的无名块？

heart1982

以下是创建无名块的程序，可惜不能容纳带有属性的实体。求助帮我解决这个问题 (defun mc-make-unname-block (ss / count entlist ent blk)
(entmake '((0 . "BLOCK") (2 . "*U") (70 . 1) (10 0 0 0)))
(setq count 0)
(repeat (sslength ss)
(setq entlist (entget (setq ent (ssname ss count))))
(setq count (1+ count))
(entmake entlist)
)
(setq count 0)
(repeat (sslength ss)
(setq ent (ssname ss count))
(setq count (1+ count))
(entdel ent)
)
(setq blk (entmake '((0 . "ENDBLK"))))
(if (princ blk)
(entmake (list (cons 0 "INSERT")
(cons 2 blk)
(cons 10 '(0 0 0))
)
)
)
blk
)
语法
(mc-make-unname-block ss)
参数
ss：选择集
返回值
无名块
样例
(mc-make-unname-block (ssget))
说明
函数对选择集中存在具有属性的图块及复杂多义线无效

alin

2. (defun c:unblock(/ doc mspace objs pt pt blkdef)
3.    (vl-load-com)
4.    (setq doc (vla-get-activedocument (vlax-get-acad-object))
5.   mspace (vla-get-modelspace doc)
6.                ss (ssget)
7.   objs (selectionset->vla-object-list ss)
8.                pt (getpoint "\n选择插入点：")
9.                blkdef (blk:make-block pt "*U" objs doc))
10.    (mapcar 'vla-delete objs)
11.    (vla-insertblock mspace (vlax-3d-point pt) (vla-get-name blkdef) 1 1 1 0)
12.    (mapcar 'vlax-release-object (list doc mspace blkdef))
13.    (princ)
14. )
15.    
16. ;BLK:MAKE-BLOCK_______________________________________________
17. ;Creates a block out of list of vla-objects
18. ;Arguments
19. ; 1) insertion point <(x y z)>
20. ; 2) block name <string>
21. ; 3) list of entities as vla-objects
22. ; 4) document object
23. ; 5) Use "*u" as the blockname argument to this function
24. ;       TO MAKE AN UNNAMED BLOCK(defun blk:make-block (ip blockname vla-objects doc / blkobj sArray)
25.    (setq
26.        blkobj (vla-add (vla-get-blocks doc) (vlax-3d-point ip) blockname)
27.        sArray
28.        (vlax-safearray-fill
29.            (vlax-make-safearray
30.                vlax-vbObject
31.                (cons 0 (1- (length vla-objects)))
32.            )
33.            vla-objects
34.        )
35.    )
36.    (vla-copyobjects doc sArray blkobj)
37.    blkobj
38. )
39. ;;;
40. (defun selectionset->vla-object-list (sset / thelist idx)
41.    (setq  thelist  '()
42.   idx -1
43.    )
44.    (repeat (sslength sset)
45.        (setq thelist (append thelist
46.          (list  (vlax-ename->vla-object
47.            (ssname sset (setq idx (1+ idx)))
48.         )
49.          )
50.        )
51.        )
52.    )
53. )
54. ;;;

(defun c:unblock(/ doc mspace objs pt pt blkdef)    (vl-load-com)    (setq doc (vla-get-activedocument (vlax-get-acad-object))   mspace (vla-get-modelspace doc)                ss (ssget)   objs (selectionset->vla-object-list ss)                pt (getpoint "\n选择插入点：")                blkdef (blk:make-block pt "*U" objs doc))    (mapcar 'vla-delete objs)    (vla-insertblock mspace (vlax-3d-point pt) (vla-get-name blkdef) 1 1 1 0)    (mapcar 'vlax-release-object (list doc mspace blkdef))    (princ) )     ;BLK:MAKE-BLOCK_______________________________________________ ;Creates a block out of list of vla-objects ;Arguments ; 1) insertion point <(x y z)> ; 2) block name <string> ; 3) list of entities as vla-objects ; 4) document object ; 5) Use "*u" as the blockname argument to this function ;       TO MAKE AN UNNAMED BLOCK(defun blk:make-block (ip blockname vla-objects doc / blkobj sArray)    (setq        blkobj (vla-add (vla-get-blocks doc) (vlax-3d-point ip) blockname)        sArray        (vlax-safearray-fill            (vlax-make-safearray                vlax-vbObject                (cons 0 (1- (length vla-objects)))            )            vla-objects        )    )    (vla-copyobjects doc sArray blkobj)    blkobj ) ;;; (defun selectionset->vla-object-list (sset / thelist idx)    (setq  thelist  '()   idx -1    )    (repeat (sslength sset)        (setq thelist (append thelist          (list  (vlax-ename->vla-object            (ssname sset (setq idx (1+ idx)))         )          )        )        )    ) ) ;;;