炸开块中块→att属性成Text文字
;;炸开块中块→att属性成Text文字;;借用了明经一位高手的程序,记不得是哪位了,很是抱歉.由于高手是用Vlisp,我对此不太懂,用此改造成炸开块中块,使用以来,没有发现问题.我至今也使用它.
;;欢迎大家指正
;;;***************************************************************************
(defun HH:ATT2TXT (/ EN I SS)
(vl-load-com)
;;1程序开始标记
(defun UndoBegin ()
(vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
;;2程序结束标记
(defun UndoEnd ()
(vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
)
;;3[功能] 获取在图元 en 之后产生的图元的选择集
(defun HH:ss-entnext (en / ss)
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (wcmatch (cdr (assoc 0 (entget en)))
"ATTRIB,VERTEX,SEQEND"
)
)
(ssadd en ss)
)
)
(if (zerop (sslength ss))
(setq ss nil)
)
ss
)
;;4清理
(defun HH:purge ()
(repeat 3
(vla-purgeall
(vla-get-activedocument (vlax-get-acad-object))
)
)
)
;;5选择集相减
(defun SS_SSsub (ss1 ss2 / ss)
(command "._Select" ss1 "_Remove" ss2 "")
(if (equal (sslength ss1) (sslength ss2))
nil
(setq ss (ssget "_P"))
)
)
;;6块爆破
(defun explodeBlock (bloc / N SS SSATT SSBLOCKS)
(command "explode" bloc)
(setq ss (ssget "_P"))
(setq ssAtt (ssget "_P" '((0 . "INSERT") (66 . 1))))
(command "select" ss "")
(setq ssBlocks (ssget "_P" '((0 . "INSERT,HATCH,REGION"))))
(if (and ssAtt ssBlocks)
(setq ssBlocks (SS_SSsub ssBlocks ssAtt))
)
(setq n -1)
(if ssBlocks
(repeat (sslength ssBlocks)
(explodeBlock (ssname ssBlocks (setq n (1+ n))))
)
)
(setq n -1)
(if ssAtt
(repeat (sslength ssAtt) (A2T (ssname ssAtt (setq n (1+ n)))))
)
ssAtt
)
;;7属性块爆破
;;7.1 子函数
(defun DXF (code elist) (cdr (assoc code elist)))
;;7.2 子函数
(defun MakeObject (obj)
(cond
((= (type obj) 'VLA-OBJECT) obj)
((= (type obj) 'ENAME) (vlax-ename->vla-object obj))
)
)
;;7.3 子函数
(defun VarArray->List (vaobj)
(vlax-SafeArray->List
(vlax-Variant-Value vaobj)
)
)
;;7.4 子函数
(defun Explode (obj / temp)
(setq temp (vla-explode obj))
(vla-delete obj)
temp
)
;;7.5 主函数
(defun A2T (obj / ATTCOL ATTLIST ATTLYR ATTOBJ BKWD BLOCKS COLR ENT HEIGHT IDX INSPT
JUST LASTENT1 LAYR LTYP N OBJLIST ROT SPACE SSATT SSBLOCKS STYLE TMP TXT
TXTPT UPSID WIDTH
)
(setq lastent1 (entlast))
(if (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))
)
)
)
)
(setq blocks (HH:ss-entnext lastent1))
(command "select" blocks "")
(setq ssAtt (ssget "_P" '((0 . "INSERT") (66 . 1))))
(command "select" blocks "")
(setq ssBlocks (ssget "_P" '((0 . "INSERT,HATCH,REGION"))))
(if (and ssAtt ssBlocks)
(setq ssBlocks (SS_SSsub ssBlocks ssAtt))
)
(setq n -1)
(if ssBlocks
(repeat (sslength ssBlocks)
(explodeBlock (ssname ssBlocks (setq n (1+ n))))
)
)
(setq n -1)
(if ssAtt
(repeat (sslength ssAtt) (A2T (ssname ssAtt (setq n (1+ n)))))
)
)
;;8 主函数
(princ "\n 选择块来爆破,属性转成文字...")
(if (cadr (ssgetfirst))
(setq ss (ssget "_P" '((0 . "INSERT"))))
) ;有预选择集时，从预选择集中找出属性块选择集
(if ss
nil
(setq ss (ssget (list (cons 0 "INSERT"))))
)
(UndoBegin)
(if ss
(progn
(setq i 0)
(repeat (sslength ss)
(setq en (ssname ss i))
(if (VL-POSITION ' (66 . 1) (entget en)) (A2T en)(explodeBlock en))
(setq i (1+ i))
)
)
)
(UndoEnd)
;;9 清理
(HH:purge)
;;10 释放无用内存
(gc)
)
;;;***********************************************************************
;;不过,"炸开块中块→att属性成Text文字",我觉得用ET中的burst.lsp改造的更好
本帖最后由 Gu_xl 于 2012-4-15 20:53 编辑
自贡黄明儒 发表于 2012-4-15 15:26 static/image/common/back.gif
;;不过,"炸开块中块→att属性成Text文字",我觉得用ET中的burst.lsp改造的更好
我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html
二楼！
Gu_xl 发表于 2012-4-15 20:52 static/image/common/back.gif
我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html
问题是你的都是.VLX的 Gu_xl 发表于 2012-4-15 20:52 static/image/common/back.gif
我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html
版主，我用你的程序的时候线宽自动显示，炸立体图块的时候有些问题 自贡黄明儒 发表于 2012-4-15 22:52 static/image/common/back.gif
问题是你的都是.VLX的
对啦 pzweng 发表于 2012-4-16 10:37 static/image/common/back.gif
版主，我用你的程序的时候线宽自动显示，炸立体图块的时候有些问题
谢谢！学习哦 呵呵，学习下先 直接用burst就可以了，为什么还要用其它的呢 自贡黄明儒 发表于 2012-4-15 15:26 static/image/common/back.gif
;;不过,"炸开块中块→att属性成Text文字",我觉得用ET中的burst.lsp改造的更好
这个命令是什么啊？能说下吗？