entmake生成块怎样包含属性块

CAD新军

用entmake做块，当嵌套包含属性块时会提示无效复杂对象。有没有方法解决呢？

CAD新军

用的代码是lisp分类学习手册的函数

CAD新军

2. 函数：
   
3. mc-make-unname-block
   
4. 功能：
   
5. 生成无名图块
   
6. 函数代码：
   
7. (defun mc-make-unname-block(ss / count entlist ent blk)
   
8.   (entmake '((0 . "BLOCK")   (2 . "*U")    (70 . 1)    (10 0 0 0)     ))
   
9.   (setq count 0)
   
10.   (repeat (sslength ss)
    
11.     (setq entlist(entget(setq ent(ssname ss  count))))
    
12.     (setq count (1+ count))
    
13.     (entmake entlist)
    
14.     )
    
15.   (setq count 0)
    
16.   (repeat(sslength ss)
    
17.     (setq ent(ssname ss count))
    
18.     (setq count (1+ count))
    
19.     (entdel ent)
    
20.     )
    
21.   (setq blk(entmake '((0 . "ENDBLK"))))
    
22.   (if (princ blk)
    
23.   (entmake (list (cons 0  "INSERT")
    
24.   (cons 2 blk)
    
25.      (cons 10 '(0 0 0))    ))
    
26.     )
    
27.   blk
    
28.   )语法：
    
29. (mc-make-unname-block ss)
    
30. 参数：
    
31. ss：选择集
    
32. 返回值：
    
33. 无名块
    
34. 示例：
    
35. (mc-make-unname-block (ssget))
    
36. 说明：
    
37. 函数对选择集中存在具有属性的图块及复杂多义线无效

函数：<br /> mc-make-unname-block <br /> 功能：<br /> 生成无名图块 <br /> 函数代码：<br /> (defun mc-make-unname-block(ss / count entlist ent blk)<br />   (entmake '((0 . "BLOCK")   (2 . "*U")    (70 . 1)    (10 0 0 0)     ))<br />   (setq count 0)<br />   (repeat (sslength ss)<br />     (setq entlist(entget(setq ent(ssname ss  count))))<br />     (setq count (1+ count))<br />     (entmake entlist)<br />     )<br />   (setq count 0)<br />   (repeat(sslength ss)<br />     (setq ent(ssname ss count))<br />     (setq count (1+ count))<br />     (entdel ent)<br />     )<br />   (setq blk(entmake '((0 . "ENDBLK"))))<br />   (if (princ blk)<br />   (entmake (list (cons 0  "INSERT")<br />   (cons 2 blk)<br />      (cons 10 '(0 0 0))    ))<br />     )<br />   blk<br />   )语法：<br /> (mc-make-unname-block ss) <br /> 参数：<br /> ss：选择集<br /> 返回值：<br /> 无名块<br /> 示例：<br /> (mc-make-unname-block (ssget))<br /> 说明：<br /> 函数对选择集中存在具有属性的图块及复杂多义线无效

wang_cn10

属性块不能做成匿名块，但可以做成多重引用匿名块
(defun MIntoBlock ( / ss adoc blk obj objs pts ptc i )
  (while (null (setq ss (ssget))))
  (setq pts (get-outbox ss))
  (setq ptc (get-midpt (car pts) (cadr pts)))
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (setq blk (vla-add (vla-get-blocks adoc) (vlax-3d-point ptc) "*U" ))
  (repeat (setq i (sslength ss))
    (setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
    (setq objs (cons obj objs))
   )
  (vlax-invoke adoc 'copyobjects objs blk)
  (mapcar 'vla-delete objs)
  (vla-AddMInsertBlock (vla-get-modelspace adoc) (vlax-3d-point ptc) (vla-get-name blk) 1 1 1 0 2 2 0 0)
  (princ)
)

尘缘一生

wang_cn10 发表于 2020-1-15 14:16
属性块不能做成匿名块，但可以做成多重引用匿名块
(defun MIntoBlock ( / ss adoc blk obj objs pts ptc i ...

这个代码不错，但是做成了咋炸开呢？

wang_cn10

尘缘一生 发表于 2020-3-18 00:43
这个代码不错，但是做成了咋炸开呢？

(defun MIntoBlockExplode ( / ss enf ent n x y )
  (while (null (setq ss (ssget ":s" (list (cons 0 "INSERT"))))))
  (repeat (setq n (sslength ss))
    (setq ent (entget (ssname ss (setq n (1- n)))))
    (mapcar '(lambda ( x y ) (setq ent (subst x y ent)))
            (list (cons 44 0) (cons 45 0) (cons 70 0) (cons 71 0))
            (list (assoc 44 ent) (assoc 45 ent) (assoc 70 ent) (assoc 71 ent))
        )
    (entmod ent)
    (setq ent (entget (ssname ss n)))
    (entdel (ssname ss n))
    (entmake (subst (cons 100 "AcDbBlockReference") (cons 100 "AcDbMInsertBlock") ent))
    (setq enf (entlast))
    (vla-explode (vlax-ename->vla-object enf))
    (entdel enf)
   )
  (princ)
)