求改造炸开属性块
本帖最后由 尘缘一生 于 2015-2-13 06:04 编辑ET工具有个 BIEST.LSP,但这个程序要求选择实体的，但它最大的优点就是：不出错，其余开发，在天正图使用，经常变量错误，中断执行。
据此，特在此征求对其改造:那就是搜索全图，自动执行的！
对于会开发的同志们来说，就是几句代码而已，万望举手之劳，因为，炸开属性块的代码，我都实验了，这个它基本不出错的，因为垃圾天正轴线号经常炸开全是个A。
(foreach x (cx-ss2en (ssget "x" lst))
~~~
)
冒充GU_XL发帖//...? 自己顶起此贴：
到目前为止，这个问题，就是下面程序：
;;; ***********************************************************************
(defun undobegin ()
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
)
;;--------------------------------------------------------------
(defun undoend ()
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
;;--------------------------------------------------------------
(defun a2t (obj / attlist attobj txt txtpt just inspt height width rot genflag layr ent idx objlist style space tmp upsid bkwd ltyp
colr attlyr attcol
)
(if (and
(= (dxf 0 (entget obj)) "INSERT")
(setq obj (makeobject obj))
)
(if (= (vla-get-hasattributes obj) :vlax-true)
(progn
(setq attlist (vararray->list (vla-getattributes obj))
idx 0
layr (vla-get-layer obj)
ltyp (vla-get-linetype obj)
colr (vla-get-color obj)
)
(repeat (length attlist)
(setq attobj (nth idx attlist)
txt (append
txt
(list (vla-get-textstring attobj))
)
txtpt (append
txtpt
(list (vla-get-textalignmentpoint attobj))
)
inspt (append
inspt
(list (vla-get-insertionpoint attobj))
)
just (append
just
(list (vla-get-alignment attobj))
)
height (append
height
(list (vla-get-height attobj))
)
width (append
width
(list (vla-get-scalefactor attobj))
)
rot (append
rot
(list (vla-get-rotation attobj))
)
style (append
style
(list (vla-get-stylename attobj))
)
upsid (append
upsid
(list (vla-get-upsidedown attobj))
)
bkwd (append
bkwd
(list (vla-get-backward attobj))
)
attlyr (append
attlyr
(list (vla-get-layer attobj))
)
attcol (append
attcol
(list (vla-get-color attobj))
)
idx (1+ idx)
)
)
(setq objlist (vararray->list (explode obj))
idx 0
)
(repeat (length objlist)
(setq ent (dxf 0 (entget (vlax-vla-object->ename (nth idx objlist)))))
(if (= ent "ATTDEF")
(vla-erase (nth idx objlist))
(if (= (vla-get-layer (nth idx objlist)) "0")
(progn
(vla-put-layer (nth idx objlist) layr)
(vla-put-linetype (nth idx objlist) ltyp)
(vla-put-color (nth idx objlist) colr)
)
)
)
(setq idx (1+ idx))
)
(setq space (if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) acmodelspace)
(vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
(vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
)
idx 0
)
(repeat (length attlist)
(setq tmp (vla-addtext space (nth idx txt) (nth idx inspt) (nth idx height)))
(vla-put-alignment tmp (nth idx just))
(if (and
(/= (nth idx just) acalignmentleft)
(/= (nth idx just) acalignmentfit)
(/= (nth idx just) acalignmentaligned)
)
(vla-move tmp (vla-get-textalignmentpoint tmp) (nth idx txtpt))
(progn
(vla-move tmp (vla-get-insertionpoint tmp) (nth idx inspt))
(vla-put-alignment tmp acalignmentleft)
)
)
(vla-put-rotation tmp (nth idx rot))
(vla-put-scalefactor tmp (nth idx width))
(vla-put-stylename tmp (nth idx style))
(if (/= (nth idx attlyr) "0")
(vla-put-layer tmp (nth idx attlyr))
(vla-put-layer tmp layr)
)
(if (/= (nth idx attlyr) "0")
(vla-put-color tmp (nth idx attcol))
(vla-put-color tmp colr)
)
(cond
((and
(= (nth idx upsid) :vlax-true)
(= (nth idx bkwd) :vlax-false)
)
(vla-put-textgenerationflag tmp actextflagupsidedown)
)
((and
(= (nth idx upsid) :vlax-false)
(= (nth idx bkwd) :vlax-true)
)
(vla-put-textgenerationflag tmp actextflagbackward)
)
((and
(= (nth idx upsid) :vlax-true)
(= (nth idx bkwd) :vlax-true)
)
(vla-put-textgenerationflag tmp (+ actextflagbackward actextflagupsidedown))
)
)
(setq idx (1+ idx))
)
)
)
)
(undoend)
)
;;--------------------------------------------------------------
(defun C:T-EXPLODE(/ s p n l)
;; 炸开属性块，属性转文字
(setq s nil)
(if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 66 1))))
(progn
(if (null vlax-dump-object) (vl-load-com) );;;将 Visual LISP 扩展功能加载到 AutoLISP
(setq p(sslength s))
(setq n 0 )
(undobegin)
(setq p(- p 1))
(while (<= n p)
(a2t (ssname s n))
(setq n (+ n 1))
(undoend)
)
)
)
)
我要说的是：上面程序不完美，很多失败，不能奏效，有的炸开一塌糊涂，这个问题，大家没有好编程吗？
尘缘一生 发表于 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 我再次顶起帖子，那就是：有没有炸开属性成文字的程序，全图的，支持各版本的！
搜分解属性块
但
不支持天正图元 burst在r14就有了
里面不少bug
页:
[1]