[编程申请]：怎么样用LSP炸开块，但在原位置写其属性？编个例子！万分感谢！

zhaosujun

谢谢！！

XDSoft

最初由 zhaosujun 发布
[B]谢谢！！ [/B]

上个帖子已经回答了，告诉你的思路了，你自己写写试试，有问题再贴论坛。

前些天，给大家写了个把“属性定义”变换成文字的程序，你去看看。

http://www.xdcad.net/forum/showthread.php?postid=82614#post82614

wwwchard

2. 
   
3. (defun c:dx(/ cla ss n na e naa ee at1 la pt ang ath at7 at77 ee)
   
4. (setq cla(getvar "clayer"))
   
5. (setq ss(ssget  '((0 . "INSERT"))))
   
6. (if ss
   
7. (progn
   
8.   (setq n 0)
   
9.   (while(< n (sslength ss))
   
10.     (setq na(ssname ss n)
    
11.           e(cdr(assoc 8 e))
    
12.           naa(entnext na)
    
13.           ee(entget naa)
    
14.     )
    
15.     (if (= "ATTRIB" (cdr(assoc 0 ee)))
    
16.         (progn
    
17.              (setq   at1 (cdr(assoc 1 ee))
    
18.                      la (cdr(assoc 8 ee))
    
19.                      pt(cdr(assoc 10 ee))
    
20.                      ang(cdr(assoc 50 ee))
    
21.                      ath(cdr(assoc 40 ee))
    
22.                      at7(cdr(assoc 7 ee))
    
23.                      at77(cdr(assoc 3 (tblsearch "style" at7)))
    
24.                      ee(subst(cons 2 "")(assoc 2 ee) ee)
    
25.           )
    
26.           (entmod ee)(entupd na)
    
27.                 (command ".explode" na "")
    
28.                 (command ".erase" (ssget "c" (mapcar '- (list ath ath 0.) pt)
    
29.                                              (mapcar '+ (list ath ath 0.) pt)
    
30.                                              (list(cons 8 la) '(0 . "ATTDEF"))
    
31.                                   ) "")
    
32.                  (command ".layer" "s" la "")
    
33.                 (command "style" at7 at77  "" "" "" "" "" "")
    
34.                 (command "text" pt ath ang at1)
    
35.              )
    
36.           )
    
37.     (setq n (1+ n))
    
38.   )
    
39. ))
    
40. (command "layer" "s" cla "")
    
41. (princ)
    
42. )
    

<br /> (defun c:dx(/ cla ss n na e naa ee at1 la pt ang ath at7 at77 ee)<br /> (setq cla(getvar "clayer"))<br /> (setq ss(ssget  '((0 . "INSERT"))))<br /> (if ss<br /> (progn<br />   (setq n 0)<br />   (while(< n (sslength ss))<br />     (setq na(ssname ss n)<br />           e(cdr(assoc 8 e)) <br />           naa(entnext na)<br />           ee(entget naa)<br />     )<br />     (if (= "ATTRIB" (cdr(assoc 0 ee)))<br />         (progn<br />              (setq   at1 (cdr(assoc 1 ee))<br />                      la (cdr(assoc 8 ee)) <br />                      pt(cdr(assoc 10 ee)) <br />                      ang(cdr(assoc 50 ee))<br />                      ath(cdr(assoc 40 ee))<br />                      at7(cdr(assoc 7 ee))<br />                      at77(cdr(assoc 3 (tblsearch "style" at7)))<br />                      ee(subst(cons 2 "")(assoc 2 ee) ee)<br />           )<br />           (entmod ee)(entupd na)<br />                 (command ".explode" na "")<br />                 (command ".erase" (ssget "c" (mapcar '- (list ath ath 0.) pt)<br />                                              (mapcar '+ (list ath ath 0.) pt)<br />                                              (list(cons 8 la) '(0 . "ATTDEF"))<br />                                   ) "")<br />                  (command ".layer" "s" la "")<br />                 (command "style" at7 at77  "" "" "" "" "" "")<br />                 (command "text" pt ath ang at1)<br />              )<br />           )<br />     (setq n (1+ n))<br />   )<br /> ))<br /> (command "layer" "s" cla "")<br /> (princ)<br /> )<br />

炸开后，属性字符的字型 高度 角度都跟原来保持原样。
缺点：只把属性字体改做了它原来所在的层，而图块炸开后没有恢复到它本来的图层。

XDSoft

最初由 wwwchard 发布
[B][code]
(defun c:dx(/ cla ss n na e naa ee at1 la pt ang ath at7 at77 ee)
(setq cla(getvar "clayer"))
(setq ss(ssget  '((0 . "INSERT"))))
(if ss
(progn
  (setq n 0)
  (while(< n (sslength ss))
... [/B]

谢谢，你能给大家改下，炸开的实体也保持原来的层吗？

另，你去LISP论坛置顶的帖子，看看代码缩进的方法，这个帖子我替你编辑了。以后贴代码，用缩进方法吧。

秋枫

这个可以参考express tools中现成的命令。

wwwchard

我在笔记本上写好调试的，没想到粘贴过来就那样了，刚才回到这儿，看了已经缩进了，我还以为是网叶显示的缘故。谢谢XD了！