炸开块中块→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 15:26
;;不过,"炸开块中块→att属性成Text文字",我觉得用ET中的burst.lsp改造的更好

我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html
二楼！

自贡黄明儒

Gu_xl 发表于 2012-4-15 20:52
我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html

问题是你的都是.VLX的

pzweng

Gu_xl 发表于 2012-4-15 20:52
我的超级炸弹工具块属性会自动炸开为文字！
见
http://bbs.mjtd.com/thread-92912-1-1.html

版主，我用你的程序的时候线宽自动显示，炸立体图块的时候有些问题

pzweng

自贡黄明儒 发表于 2012-4-15 22:52
问题是你的都是.VLX的

对啦

tongor1

pzweng 发表于 2012-4-16 10:37
版主，我用你的程序的时候线宽自动显示，炸立体图块的时候有些问题

谢谢！学习哦

laiz3000

呵呵，学习下先

myjping

直接用burst就可以了，为什么还要用其它的呢

julian609

自贡黄明儒 发表于 2012-4-15 15:26
;;不过,"炸开块中块→att属性成Text文字",我觉得用ET中的burst.lsp改造的更好

这个命令是什么啊？能说下吗？