顽固图纸，炸属性门窗块，文字丢失
本帖最后由 尘缘一生 于 2024-7-18 04:43 编辑如题：今设计院转来图，这个问题头疼，天正的门窗属性块，
关于炸开，文字转属性问题，
本坛技术部分好像对这个图无效，组装了下代码，发个模样，算是能炸开不丢失文字了，但是不完美，还有特殊部分丢失。
图纸如下：
为了炸开此图不丢失文字，下面进行的尝试，
;炸开选择集属性块,属性转文字-----(一级)------
;(sl-a2t (ssget))
(defun sl-a2t (ss / n nam tp)
(_undo1)
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0))
(cond
((= tp "ATTDEF")
(sl-att-text nam) ;属性转文字
)
((and (= tp "INSERT") (= (dxf1 nam 66) 1) (= (vla-get-hasattributes (en2obj nam)) :vlax-true))
(slblka2t nam)
)
)
)
(_undo2)
(princ)
)
;;炸属性块blknam----(一级)--------
;(slblka2t (car (entsel)))
(defun slblka2t (blknam / obj nam str p0 ly)
(defun explode-atfblk (obj / temp)
(setq temp (vla-explode obj))
(vla-delete obj)
temp
)
;炸属性块obj--
(defun slblka2tss (obj / attlist attobj txt txtpt just inspt height width rot ent n objList style space tmp upsid bkwd ltyp attlyr attcol)
(setq attlist (vlax-SafeArray->List (vlax-Variant-Value (vla-GetAttributes obj))) n 0 ltyp (vla-get-linetype obj))
(repeat (length attlist)
(setq
attobj (nth n 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)))
n (1+ n)
)
)
(setq objList (vlax-SafeArray->List (vlax-Variant-Value (explode-atfblk obj))) n 0)
(repeat (length objList)
(setq ent (dxf1 (obj2en (nth n objList)) 0))
(if (= ent "ATTDEF")
(vla-erase (nth n objList))
(if (= (vla-get-layer (nth n objList)) "0")
(progn
(vla-put-layer (nth n objList) ly)
(vla-put-linetype (nth n objList) ltyp)
(vla-put-color (nth n objList) col)
)
)
)
(setq n (1+ n))
)
(setq space (if (= (vla-get-activespace *AcDocument*) acModelspace) *Model-Space* *Paper-Space*) n 0)
(repeat (length attlist)
(setq tmp (vla-addText space (nth n txt) (nth n inspt) (nth n height)))
(vla-put-alignment tmp (nth n just))
(if (and
(/= (nth n just) acAlignmentLeft)
(/= (nth n just) acAlignmentFit)
(/= (nth n just) acAlignmentAligned)
)
(vla-move tmp (vla-get-TextAlignmentPoint tmp) (nth n txtpt))
(progn
(vla-move tmp (vla-get-InsertionPoint tmp) (nth n inspt))
(vla-put-alignment tmp acAlignmentLeft)
)
)
(vla-put-rotation tmp (nth n rot))
(vla-put-scalefactor tmp (nth n width))
(vla-put-stylename tmp (nth n style))
(if (/= (nth n attlyr) "0") (vla-put-layer tmp (nth n attlyr)) (vla-put-layer tmp ly))
(if (/= (nth n attlyr) "0") (vla-put-color tmp (nth n attcol)) (vla-put-color tmp col))
(cond
((and (= (nth n upsid) :vlax-true) (= (nth n bkwd) :vlax-false))
(vla-put-textgenerationflag tmp acTextFlagUpsideDown)
)
((and (= (nth n upsid) :vlax-false) (= (nth n bkwd) :vlax-true))
(vla-put-textgenerationflag tmp acTextFlagBackward)
)
((and (= (nth n upsid) :vlax-true) (= (nth n bkwd) :vlax-true))
(vla-put-textgenerationflag tmp (+ acTextFlagBackward acTextFlagUpsideDown))
)
)
(setq n (1+ n))
)
(princ)
)
;;-------------
(if (and (= (dxf1 blknam 0) "INSERT") (= (dxf1 blknam 66) 1) (setq obj (en2obj blknam)) (= (vla-get-hasattributes obj) :vlax-true))
(progn
(setq p0 (e9pt blknam 2) ly (vla-get-layer obj) col (vla-get-color obj))
(if (vl-catch-all-error-p (vl-catch-all-apply 'slblka2tss (list obj))) ;注 本程序炸开本帖分享图纸，文字丢失
(if (and (setq nam (entnext blknam)) (setq str (getstr nam))) ;注 以下4句，为了炸开顽固图纸，做了新写出来，getstr 取实体字符集成，SLdesign V3.0modify by尘缘一生QQ:15290049
(progn
(slmkwz str p0 (/ (e-higt nam) slbl) (e-ang nam nil) 0.7 ly $hz nil "m")
(text:alignmod (entlast) "L")
)
)
)
)
)
)
;属性->转换为文本实体-----(一级)----
(defun sl-att-text (anam / ent new dolst addto)
(if (= "ATTDEF" (dxf1 anam 0))
(progn
(setq ent (entget anam))
(setq new '((0 . "TEXT")))
(setq new (append new (list (cons 1 (dxf1 anam 2)))))
(setq dolst (list 7 8 10 11 39 40 41 50 51 62 71 72 73))
(foreach x dolst
(setq addto (assoc x ent))
(if (/= addto nil) (setq new (append new (list addto))))
)
(entdel anam)
(entmake new)
)
)
)
;;属性选择集转文本-----(一级)--------
(defun att2txt (ss / nam n i) ;(att2txt (ssget))
(setq i 0)
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))))
(if (= (dxf1 nam 0) "ATTDEF")
(progn
(setq i (1+ i))
(sl-att-text nam)
(entdel nam)
)
)
)
(princ (strcat (slmsg "\n 共 " "\n " "\n total ") (rtos i 2 0) (slmsg " 个属性转为文字!" " 妮┦锣ゅ!" " Attributes converted to text!")))
)注：burst我有的是，但是，都不能解决这个问题，就这个特殊，那么你怎么炸开的？
如果你炸开了不丢失，说明你炸好了即可，用的什么？明确说下。 本帖最后由 KO你 于 2024-7-19 17:53 编辑
论坛里可以找得到，忘记是那个大佬的了，测试过没问题
快捷键pburst属性块分解 可以分解不允许分解的块
快捷键nburst嵌套属性块分解 可以分解不允许分解的块
(defun c:pburst nil (LM:burst nil))
(defun c:nburst nil (LM:burst t))
;;----------------------------------------------------------------------;;
(defun LM:burst ( nst / *error* )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(LM:startundo (LM:acdoc))
(LM:burstsel
(LM:ssget "\n选择要分解的块: "
(list "_:L"
(append '((0 . "INSERT"))
(
(lambda ( / def lst )
(while (setq def (tblnext "block" (null def)))
(if (= 4 (logand 4 (cdr (assoc 70 def))))
(setq lst (vl-list* "," (cdr (assoc 2 def)) lst))
)
)
(if lst (list '(-4 . "<NOT") (cons 2 (apply 'strcat (cdr lst))) '(-4 . "NOT>")))
)
)
(if (= 1 (getvar 'cvport))
(list (cons 410 (getvar 'ctab)))
'((410 . "Model"))
)
)
)
)
nst
)
(LM:endundo (LM:acdoc)) (princ)
)
(defun LM:burstsel ( sel nst / idx )
(if (= 'pickset (type sel))
(repeat (setq idx (sslength sel))
(LM:burstobject (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) nst)
)
)
)
(defun LM:burstobject ( obj nst / cmd col ent err lay lin lst qaf tmp )
(if
(and
(= "AcDbBlockReference" (vla-get-objectname obj))
(not (vlax-property-available-p obj 'path))
(vlax-write-enabled-pobj)
(or (and (LM:usblock-p obj)
(not (vl-catch-all-error-p (setq err (vl-catch-all-apply 'vlax-invoke (list obj 'explode)))))
(setq lst err)
)
(progn
(setq tmp (vla-copy obj)
ent (LM:entlast)
cmd (getvar 'cmdecho)
qaf (getvar 'qaflags)
)
(setvar 'cmdecho 0)
(setvar 'qaflags 0)
(vl-cmdf "_.explode" (vlax-vla-object->ename tmp))
(setvar 'qaflags qaf)
(setvar 'cmdecho cmd)
(while (setq ent (entnext ent))
(setq lst (cons (vlax-ename->vla-object ent) lst))
)
lst
)
)
)
(progn
(setq lay (vla-get-layer obj)
col (vla-get-color obj)
lin (vla-get-linetype obj)
)
(foreach att (vlax-invoke obj 'getattributes)
(if (vlax-write-enabled-p att)
(progn
(if (= "0" (vla-get-layer att))
(vla-put-layer att lay)
)
(if (= acbyblock (vla-get-color att))
(vla-put-color att col)
)
(if (= "byblock" (strcase (vla-get-linetype att) t))
(vla-put-linetype att lin)
)
)
)
(if
(and
(= :vlax-false (vla-get-invisible att))
(= :vlax-true(vla-get-visible att))
)
( (if (and (vlax-property-available-p att 'mtextattribute) (= :vlax-true (vla-get-mtextattribute att)))
LM:burst:matt2mtext
LM:burst:att2text
)
(entget (vlax-vla-object->ename att))
)
)
)
(foreach new lst
(cond
( (not (vlax-write-enabled-p new)))
( (= :vlax-false (vla-get-visible new))
(vla-delete new)
)
( t
(if (= "0" (vla-get-layer new))
(vla-put-layer new lay)
)
(if (= acbyblock (vla-get-color new))
(vla-put-color new col)
)
(if (= "byblock" (strcase (vla-get-linetype new) t))
(vla-put-linetype new lin)
)
(if (= "AcDbAttributeDefinition" (vla-get-objectname new))
(progn
(if
(and
(= :vlax-true(vla-get-constantnew))
(= :vlax-false (vla-get-invisible new))
)
( (if (and (vlax-property-available-p new 'mtextattribute) (= :vlax-true (vla-get-mtextattribute new)))
LM:burst:matt2mtext
LM:burst:att2text
)
(entget (vlax-vla-object->ename new))
)
)
(vla-delete new)
)
(if nst (LM:burstobject new nst))
)
)
)
)
(vla-delete obj)
)
)
)
(defun LM:burst:removepairs ( itm lst )
(vl-remove-if '(lambda ( x ) (member (car x) itm)) lst)
)
(defun LM:burst:remove1stpairs ( itm lst )
(vl-remove-if '(lambda ( x ) (if (member (car x) itm) (progn (setq itm (vl-remove (car x) itm)) t))) lst)
)
(defun LM:burst:att2text ( enx )
(entmakex
(append '((0 . "TEXT"))
(LM:burst:removepairs '(000 002 003 070 074 100 280 440)
(subst (cons 73 (cdr (assoc 74 enx))) (assoc 74 enx) enx)
)
)
)
)
(defun LM:burst:matt2mtext ( enx )
(entmakex
(append '((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText"))
(LM:burst:remove1stpairs
(if (= "ATTDEF" (cdr (assoc 0 enx)))
'(001 003 007 010 040 041 050 071 072 073 210)
'(001 007 010 040 041 050 071 072 073 210)
)
(LM:burst:removepairs '(000 002 011 042 043 051 070 074 100 101 102 280 330 360 440) enx)
)
(list (assoc 011 (reverse enx)))
)
)
)
;; Uniformly Scaled Block-Lee Mac
;; Returns T if the supplied VLA Block Reference is uniformly scaled
;; obj - VLA Block Reference
(defun LM:usblock-p ( obj / s )
(if (vlax-property-available-p obj 'xeffectivescalefactor)
(setq s "effectivescalefactor")
(setq s "scalefactor")
)
(eval
(list 'defun 'LM:usblock-p '( obj )
(list 'and
(list 'equal
(list 'abs (list 'vlax-get-property 'obj (strcat "x" s)))
(list 'abs (list 'vlax-get-property 'obj (strcat "y" s)))
1e-8
)
(list 'equal
(list 'abs (list 'vlax-get-property 'obj (strcat "x" s)))
(list 'abs (list 'vlax-get-property 'obj (strcat "z" s)))
1e-8
)
)
)
)
(LM:usblock-p obj)
)
;; entlast-Lee Mac
;; A wrapper for the entlast function to return the last subentity in the database
(defun LM:entlast ( / ent tmp )
(setq ent (entlast))
(while (setq tmp (entnext ent)) (setq ent tmp))
ent
)
;; ssget-Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - selection prompt
;; arg - list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo-Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo-Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document-Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;
对这一问题，再次组织代码，不用那么长写法。
对于复合CAD标准的图纸，实际代码不复杂，并能做到完美，就怕特殊软件画的图。
;;炸属性块blknam----(一级)--------
;(slblka2t (car (entsel)))
;modify by 尘缘一生
(defun slblka2t (blknam / e attnam atdef nam obj str p h ly ang col ss)
(setq e (entlast))
(if (and (= (dxf1 blknam 0) "INSERT") (= (dxf1 blknam 66) 1) (setq obj (en2obj blknam)) (= (vla-get-hasattributes obj) :vlax-true))
(progn
(setq attnam (entnext blknam))
(while (= "ATTRIB" (dxf1 attnam 0))
(setq p (e9pt attnam 5) str (dxf1 attnam 1) h (dxf1 attnam 40) ang (angle-sharp (dxf1 attnam 50)) ly (dxf1 attnam 8) col (sl-getcolor attnam))
(if (/= "STAR" (dxf1 attnam 2))
(progn
(slmkwz str p (/ h slbl) ang 0.7 ly $hz col "m")
(text:alignmod (entlast) "L")
(if (if-color) ;变色系统激活
(vla-put-color (en2obj (entlast)) (atoi (slsjqs)))
)
)
)
(setq attnam (entnext attnam))
)
(command "explode" blknam)
)
)
(setq ss (last_ent e))
(while (setq atdef (ssname ss 0))
(if (= (dxf1 atdef 0) "ATTDEF")
(entdel atdef)
)
(ssdel atdef ss)
)
(princ)
)
;炸开选择集属性块,属性转文字-----(一级)------
;(sl-a2t (ssget))
(defun sl-a2t (ss / n nam tp)
(_undo1)
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))) tp (dxf1 nam 0))
(cond
((= tp "ATTDEF")
(sl-att-text nam) ;属性转文字
)
((and (= tp "INSERT") (= (dxf1 nam 66) 1) (= (vla-get-hasattributes (en2obj nam)) :vlax-true))
(slblka2t nam)
)
)
)
(_undo2)
(princ)
)
;;测试---
(defun c:tt ()
(if (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1))))
(sl-a2t ss)
)
)
lxl217114 发表于 2024-7-18 09:12
命令栏输入burst、回车、点选需要炸开的属性块、回车
直接解决
:lol
刚才试了一下，对于“炸门窗块_t3.dwg”
burst确实也可以。
不过因为字体的缺少要代替。
{:1_1:} burst不是轻松解决么？ 小菜123 发表于 2024-7-17 21:44
burst不是轻松解决么？
先转t3再炸呢 压缩包里就是t3，我是试过了才说的
burst炸属性块为文字 jh3030912 发表于 2024-7-17 21:52
先转t3再炸呢
burst直接解决 burst可以:lol 装B失败，挫的1P 本帖最后由 lxl217114 于 2024-7-18 09:42 编辑
命令栏输入burst、回车、点选需要炸开的属性块、回车
直接解决
老陈喝假酒了吧，31年画图经验居然这么不堪一击
页:
[1]
2