求改造炸开属性块

尘缘一生

       ET工具有个 BIEST.LSP,但这个程序要求选择实体的，但它最大的优点就是：不出错，其余开发，在天正图使用，经常变量错误，中断执行。

    据此，特在此征求对其改造:那就是搜索全图，自动执行的！


              对于会开发的同志们来说，就是几句代码而已，万望举手之劳，因为，炸开属性块的代码，我都实验了，这个它基本不出错的，因为垃圾天正轴线号经常炸开全是个A。

鱼与熊掌

(foreach x (cx-ss2en (ssget "x" lst))
~~~
)
冒充GU_XL发帖//...?

尘缘一生

自己顶起此贴：
到目前为止，这个问题，就是下面程序：

1. ;;; ***********************************************************************
   
2. (defun undobegin ()
   
3.   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   
4.   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
   
5. )
   
6. ;;--------------------------------------------------------------
   
7. (defun undoend ()
   
8.   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
   
9. )
   
10. ;;--------------------------------------------------------------
    
11. (defun a2t (obj / attlist attobj txt txtpt just inspt height width rot genflag layr ent idx objlist style space tmp upsid bkwd ltyp
    
12.              colr attlyr attcol
    
13.            )
    
14.   (if (and
    
15.         (= (dxf 0 (entget obj)) "INSERT")
    
16.         (setq obj (makeobject obj))
    
17.       )
    
18.     (if (= (vla-get-hasattributes obj) :vlax-true)
    
19.       (progn
    
20.         (setq attlist (vararray->list (vla-getattributes obj))
    
21.           idx 0
    
22.           layr (vla-get-layer obj)
    
23.           ltyp (vla-get-linetype obj)
    
24.           colr (vla-get-color obj)
    
25.         )
    
26.         (repeat (length attlist)
    
27.           (setq attobj (nth idx attlist)
    
28.             txt (append
    
29.                   txt
    
30.                   (list (vla-get-textstring attobj))
    
31.                 )
    
32.             txtpt (append
    
33.                     txtpt
    
34.                     (list (vla-get-textalignmentpoint attobj))
    
35.                   )
    
36.             inspt (append
    
37.                     inspt
    
38.                     (list (vla-get-insertionpoint attobj))
    
39.                   )
    
40.             just (append
    
41.                    just
    
42.                    (list (vla-get-alignment attobj))
    
43.                  )
    
44.             height (append
    
45.                      height
    
46.                      (list (vla-get-height attobj))
    
47.                    )
    
48.             width (append
    
49.                     width
    
50.                     (list (vla-get-scalefactor attobj))
    
51.                   )
    
52.             rot (append
    
53.                   rot
    
54.                   (list (vla-get-rotation attobj))
    
55.                 )
    
56.             style (append
    
57.                     style
    
58.                     (list (vla-get-stylename attobj))
    
59.                   )
    
60.             upsid (append
    
61.                     upsid
    
62.                     (list (vla-get-upsidedown attobj))
    
63.                   )
    
64.             bkwd (append
    
65.                    bkwd
    
66.                    (list (vla-get-backward attobj))
    
67.                  )
    
68.             attlyr (append
    
69.                      attlyr
    
70.                      (list (vla-get-layer attobj))
    
71.                    )
    
72.             attcol (append
    
73.                      attcol
    
74.                      (list (vla-get-color attobj))
    
75.                    )
    
76.             idx (1+ idx)
    
77.           )
    
78.         )
    
79.         (setq objlist (vararray->list (explode obj))
    
80.           idx 0
    
81.         )
    
82.         (repeat (length objlist)
    
83.           (setq ent (dxf 0 (entget (vlax-vla-object->ename (nth idx objlist)))))
    
84.           (if (= ent "ATTDEF")
    
85.             (vla-erase (nth idx objlist))
    
86.             (if (= (vla-get-layer (nth idx objlist)) "0")
    
87.               (progn
    
88.                 (vla-put-layer (nth idx objlist) layr)
    
89.                 (vla-put-linetype (nth idx objlist) ltyp)
    
90.                 (vla-put-color (nth idx objlist) colr)
    
91.               )
    
92.             )
    
93.           )
    
94.           (setq idx (1+ idx))
    
95.         )
    
96.         (setq space (if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) acmodelspace)
    
97.                       (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
    
98.                       (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    
99.                     )
    
100.           idx 0
     
101.         )
     
102.         (repeat (length attlist)
     
103.           (setq tmp (vla-addtext space (nth idx txt) (nth idx inspt) (nth idx height)))
     
104.           (vla-put-alignment tmp (nth idx just))
     
105.           (if (and
     
106.                 (/= (nth idx just) acalignmentleft)
     
107.                 (/= (nth idx just) acalignmentfit)
     
108.                 (/= (nth idx just) acalignmentaligned)
     
109.               )
     
110.             (vla-move tmp (vla-get-textalignmentpoint tmp) (nth idx txtpt))
     
111.             (progn
     
112.               (vla-move tmp (vla-get-insertionpoint tmp) (nth idx inspt))
     
113.               (vla-put-alignment tmp acalignmentleft)
     
114.             )
     
115.           )
     
116.           (vla-put-rotation tmp (nth idx rot))
     
117.           (vla-put-scalefactor tmp (nth idx width))
     
118.           (vla-put-stylename tmp (nth idx style))
     
119.           (if (/= (nth idx attlyr) "0")
     
120.             (vla-put-layer tmp (nth idx attlyr))
     
121.             (vla-put-layer tmp layr)
     
122.           )
     
123.           (if (/= (nth idx attlyr) "0")
     
124.             (vla-put-color tmp (nth idx attcol))
     
125.             (vla-put-color tmp colr)
     
126.           )
     
127.           (cond
     
128.             ((and
     
129.                (= (nth idx upsid) :vlax-true)
     
130.                (= (nth idx bkwd) :vlax-false)
     
131.              )
     
132.               (vla-put-textgenerationflag tmp actextflagupsidedown)
     
133.             )
     
134.             ((and
     
135.                (= (nth idx upsid) :vlax-false)
     
136.                (= (nth idx bkwd) :vlax-true)
     
137.              )
     
138.               (vla-put-textgenerationflag tmp actextflagbackward)
     
139.             )
     
140.             ((and
     
141.                (= (nth idx upsid) :vlax-true)
     
142.                (= (nth idx bkwd) :vlax-true)
     
143.              )
     
144.               (vla-put-textgenerationflag tmp (+ actextflagbackward actextflagupsidedown))
     
145.             )
     
146.           )
     
147.           (setq idx (1+ idx))
     
148.         )
     
149.       )
     
150.     )
     
151.   )
     
152.   (undoend)
     
153. )
     
154. ;;--------------------------------------------------------------
     
155. (defun C:T-EXPLODE(/ s p n l)
     
156.   ;; 炸开属性块，属性转文字
     
157.   (setq s nil)
     
158.   (if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 66 1))))
     
159.     (progn   
     
160.       (if (null vlax-dump-object) (vl-load-com) );;;将 Visual LISP 扩展功能加载到 AutoLISP
     
161.       (setq p(sslength s))
     
162.       (setq n 0 )
     
163.       (undobegin)         
     
164.       (setq p(- p 1))
     
165.       (while (<= n p)
     
166.         (a2t (ssname s n))            
     
167.         (setq n (+ n 1))
     
168.         (undoend)
     
169.       )
     
170.     )
     
171.   )
     
172. )

;;; ***********************************************************************<br /> (defun undobegin ()<br />   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br />   (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))<br /> )<br /> ;;--------------------------------------------------------------<br /> (defun undoend ()<br />   (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))<br /> )<br /> ;;--------------------------------------------------------------<br /> (defun a2t (obj / attlist attobj txt txtpt just inspt height width rot genflag layr ent idx objlist style space tmp upsid bkwd ltyp<br />              colr attlyr attcol<br />            )<br />   (if (and<br />         (= (dxf 0 (entget obj)) "INSERT")<br />         (setq obj (makeobject obj))<br />       )<br />     (if (= (vla-get-hasattributes obj) :vlax-true)<br />       (progn<br />         (setq attlist (vararray->list (vla-getattributes obj))<br />           idx 0<br />           layr (vla-get-layer obj)<br />           ltyp (vla-get-linetype obj)<br />           colr (vla-get-color obj)<br />         )<br />         (repeat (length attlist)<br />           (setq attobj (nth idx attlist)<br />             txt (append<br />                   txt<br />                   (list (vla-get-textstring attobj))<br />                 )<br />             txtpt (append<br />                     txtpt<br />                     (list (vla-get-textalignmentpoint attobj))<br />                   )<br />             inspt (append<br />                     inspt<br />                     (list (vla-get-insertionpoint attobj))<br />                   )<br />             just (append<br />                    just<br />                    (list (vla-get-alignment attobj))<br />                  )<br />             height (append<br />                      height<br />                      (list (vla-get-height attobj))<br />                    )<br />             width (append<br />                     width<br />                     (list (vla-get-scalefactor attobj))<br />                   )<br />             rot (append<br />                   rot<br />                   (list (vla-get-rotation attobj))<br />                 )<br />             style (append<br />                     style<br />                     (list (vla-get-stylename attobj))<br />                   )<br />             upsid (append<br />                     upsid<br />                     (list (vla-get-upsidedown attobj))<br />                   )<br />             bkwd (append<br />                    bkwd<br />                    (list (vla-get-backward attobj))<br />                  )<br />             attlyr (append<br />                      attlyr<br />                      (list (vla-get-layer attobj))<br />                    )<br />             attcol (append<br />                      attcol<br />                      (list (vla-get-color attobj))<br />                    )<br />             idx (1+ idx)<br />           )<br />         )<br />         (setq objlist (vararray->list (explode obj))<br />           idx 0<br />         )<br />         (repeat (length objlist)<br />           (setq ent (dxf 0 (entget (vlax-vla-object->ename (nth idx objlist)))))<br />           (if (= ent "ATTDEF")<br />             (vla-erase (nth idx objlist))<br />             (if (= (vla-get-layer (nth idx objlist)) "0")<br />               (progn<br />                 (vla-put-layer (nth idx objlist) layr)<br />                 (vla-put-linetype (nth idx objlist) ltyp)<br />                 (vla-put-color (nth idx objlist) colr)<br />               )<br />             )<br />           )<br />           (setq idx (1+ idx))<br />         )<br />         (setq space (if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) acmodelspace)<br />                       (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))<br />                       (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))<br />                     )<br />           idx 0<br />         )<br />         (repeat (length attlist)<br />           (setq tmp (vla-addtext space (nth idx txt) (nth idx inspt) (nth idx height)))<br />           (vla-put-alignment tmp (nth idx just))<br />           (if (and<br />                 (/= (nth idx just) acalignmentleft)<br />                 (/= (nth idx just) acalignmentfit)<br />                 (/= (nth idx just) acalignmentaligned)<br />               )<br />             (vla-move tmp (vla-get-textalignmentpoint tmp) (nth idx txtpt))<br />             (progn<br />               (vla-move tmp (vla-get-insertionpoint tmp) (nth idx inspt))<br />               (vla-put-alignment tmp acalignmentleft)<br />             )<br />           )<br />           (vla-put-rotation tmp (nth idx rot))<br />           (vla-put-scalefactor tmp (nth idx width))<br />           (vla-put-stylename tmp (nth idx style))<br />           (if (/= (nth idx attlyr) "0")<br />             (vla-put-layer tmp (nth idx attlyr))<br />             (vla-put-layer tmp layr)<br />           )<br />           (if (/= (nth idx attlyr) "0")<br />             (vla-put-color tmp (nth idx attcol))<br />             (vla-put-color tmp colr)<br />           )<br />           (cond<br />             ((and<br />                (= (nth idx upsid) :vlax-true)<br />                (= (nth idx bkwd) :vlax-false)<br />              )<br />               (vla-put-textgenerationflag tmp actextflagupsidedown)<br />             )<br />             ((and<br />                (= (nth idx upsid) :vlax-false)<br />                (= (nth idx bkwd) :vlax-true)<br />              )<br />               (vla-put-textgenerationflag tmp actextflagbackward)<br />             )<br />             ((and<br />                (= (nth idx upsid) :vlax-true)<br />                (= (nth idx bkwd) :vlax-true)<br />              )<br />               (vla-put-textgenerationflag tmp (+ actextflagbackward actextflagupsidedown))<br />             )<br />           )<br />           (setq idx (1+ idx))<br />         ) <br />       )<br />     )<br />   )<br />   (undoend)<br /> )<br /> ;;--------------------------------------------------------------<br /> (defun C:T-EXPLODE(/ s p n l)<br />   ;; 炸开属性块，属性转文字<br />   (setq s nil)<br />   (if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 66 1))))<br />     (progn   <br />       (if (null vlax-dump-object) (vl-load-com) );;;将 Visual LISP 扩展功能加载到 AutoLISP<br />       (setq p(sslength s))<br />       (setq n 0 )<br />       (undobegin)         <br />       (setq p(- p 1))<br />       (while (<= n p)<br />         (a2t (ssname s n))            <br />         (setq n (+ n 1))<br />         (undoend)<br />       )<br />     )<br />   )<br /> )

我要说的是：上面程序不完美，很多失败，不能奏效，有的炸开一塌糊涂，这个问题，大家没有好编程吗？

jun353835273

尘缘一生 发表于 2018-5-1 22:45
自己顶起此贴：
到目前为止，这个问题，就是下面程序：

(defun DXF (code lst / ent lst a)
  (cdr (assoc code lst))
)
(setq makeobject vlax-ename->vla-object )
还缺少
vararray->list
explode

尘缘一生

我再次顶起帖子，那就是：有没有炸开属性成文字的程序，全图的，支持各版本的！

masterlong

搜分解属性块
但
不支持天正图元

masterlong

burst在r14就有了
里面不少bug