求助帖（属性块--->文字）

julson · 发表于 2009-12-26 20:18:00

习惯使用cad文字，希望将图中属性定义块炸开，里面文字保留不变。请大侠出手帮忙。

silentbomb · 发表于 2013-1-21 21:25:33

楼上意见有人说了，BURST，CAD自带的

chenbh2 · 发表于 2019-4-20 16:56:13

xianaihua 发表于 2009-12-26 21:27

备用，谢谢！

xianaihua · 发表于 2009-12-26 21:27:00

;;;***********************************************************************
;;; ATT2TXT.LSP
;;; 通用处理函数. 可以将带属性的块爆炸，并将属性转换成文字
;;;***********************************************************************
(vl-load-com)
;;;*********************************************************************
;;; 用于该程序的使用函数
;;;*********************************************************************
(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 DXF (code elist) (cdr (assoc code elist)))
(defun MakeObject (obj)
(cond
( (= (type obj) 'VLA-OBJECT) obj)
( (= (type obj) 'ENAME) (vlax-ename->vla-object obj))
)
)
(defun Explode (obj / temp)
(setq temp (vla-explode obj))
(vla-delete obj)
temp
)
(defun VarArray->List (vaobj)
(vlax-SafeArray->List
(vlax-Variant-Value vaobj)
)
)
;;;***************************************************************************
;;; 命令行调用函数...
;;;***************************************************************************
(defun C:ATT2TXT (/ ss i)
(princ "\n选择一个属性块转成文字...")
(if (setq ss (ssget (list (cons 0 "INSERT"))))
(progn
(setq i 0)
(UndoBegin)
(repeat (sslength ss)
(A2T (ssname ss i))
(setq i (1+ i))
)
(UndoEnd)
)
)
(princ)
)
;;;***********************************************************************
;;; 主函数...
;;;***********************************************************************
(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))
)
(princ "\n属性已经转换.")
)
(princ "\n所需对象没有属性可提取")
)
(princ "\n所选实体不是块对象!")
)
(UndoEnd)
(princ)
)
;;***********************************************************************
(princ)

;;;***********************************************************************
;;; ATT2TXT.LSP
;;; 通用处理函数. 可以将带属性的块爆炸，并将属性转换成文字
;;;***********************************************************************
(vl-load-com)
;;;*********************************************************************
;;; 用于该程序的使用函数
;;;*********************************************************************
(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 DXF (code elist) (cdr (assoc code elist)))
(defun MakeObject (obj)
  (cond
    ( (= (type obj) 'VLA-OBJECT) obj)
    ( (= (type obj) 'ENAME) (vlax-ename->vla-object obj))
  )
)
(defun Explode (obj / temp)
  (setq temp (vla-explode obj))
  (vla-delete obj)
  temp
)
(defun VarArray->List (vaobj)
  (vlax-SafeArray->List
    (vlax-Variant-Value vaobj)
  )
)
;;;***************************************************************************
;;; 命令行调用函数...
;;;***************************************************************************
(defun C:ATT2TXT (/ ss i)
  (princ "\n选择一个属性块转成文字...")
  (if (setq ss (ssget (list (cons 0 "INSERT"))))
    (progn
      (setq i  0)
      (UndoBegin)
      (repeat (sslength ss)
        (A2T (ssname ss i))
        (setq i (1+ i))
      )
      (UndoEnd)
    )
  )
  (princ)
)
;;;***********************************************************************
;;; 主函数...
;;;***********************************************************************
(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))
        )
        (princ "\n属性已经转换.")
      )
      (princ "\n所需对象没有属性可提取")
  )
    (princ "\n所选实体不是块对象!")
  )
  (UndoEnd)
  (princ)
)
;;***********************************************************************
(princ)

julson · 发表于 2009-12-27 16:39:00

真的很好用，真的很感谢xianaihua大侠帮忙，比我期望的还快，比我期望的要好。

收藏了，向xianaihua大侠学习！

dwg001 · 发表于 2009-12-27 16:57:00

et工具中命令burst

sxh_why · 发表于 2009-12-27 17:00:00

新手顶，我也很想用用看

树点 · 发表于 2010-10-1 00:03:00

真是好用，非常不错

树点 · 发表于 2010-10-1 00:04:00

很实用

树点 · 发表于 2010-10-1 00:04:00

支持一下

csu_yijie · 发表于 2010-11-19 14:34:00

收藏收藏。好贴收藏

zsw23 · 发表于 2010-12-31 15:13:30

大家都说好才是真的好

账号		自动登录	找回密码
密码			注册

求助帖（属性块--->文字）

本帖子中包含更多资源

点评

评分

[原创]有没有比较方便的CAD线形制作工具