
;;;***********************************************************************
;;; 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:SX (/ 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)
