关于“炸”
本帖最后由 尘缘一生 于 2024-7-28 05:36 编辑当CAD出现时候，是画点线面，当你拿到二手图，进行深入设计之时，你首先需要的是：炸开到点、线、面，否则，你觉得挺能的（安装有好多插件奥，觉得可以了，是吧？），你试试看？你就不可能随心应手的去完善去！
所以，炸开，不是可有可无的事，然而，炸开这个问题，说是简单，包含多少问题呢？
一：各种块的炸开（普通块，嵌套块，参照块，不可炸开块，加密的块，无名块，属性块，XCLIP块.....+各种2B块.....）
二：标注的炸开
三：文字的炸开
四：属性、属性定义转文字
五：组的解散，炸开
六：炸 TCH 实体（这种垃圾，写代码针对，不值得）
.......
总之一句话，那就是，这个工具在哪里呢？什么工具，就是”彻底解散“，回家睡觉，到目前为止啊，没有，（特有的都藏起来在自己工具里，自己用着罢了！）为什么没有呢？那就是，垃圾软件层出不穷，你不可能做到，对它们也能”炸“！畜生的软件，我这么叫它们，还高看一步，否则，连畜生都不如。误导几十年的学子！
那么，关于块的炸开部分呢，我先发个模样，
本坛哪，并没有彻底炸开的集成存在，因为，这个问题，就不可以穷尽，曾记得有个VLX程序，叫”超级炸弹“，对吧？
可能啊，是真对块的，捷足先登吧，实际上，要我来说，配不上这个名字。配上这个名字的，应该是，我说的全部解散，散伙，回家睡觉，你才有脸叫”超级炸弹“，否则，你配得上吗？
;;en 图块名--嵌套炸块---(一级)-------
(defun exp-blk (en / obj e0 e ss n nam kk str1 str2)
(setq obj (en2obj en))
(if (> (abs (caddr (dxf1 en 10))) 0.0)
(vl-catch-all-apply 'zero-ent (list en))
)
(if (= (vlax-property-available-p obj "Path") nil);;非参照
(if (and (= (dxf1 en 0) "INSERT") (= (isxclip en) nil)) ;;排除xclip块
(progn
(setq e0 (entlast))
(cond
((and
(vlax-property-available-p obj 'Explodable) ;;具有分解属性
(eq :vlax-false (vla-get-Explodable obj)) ;且不允许分解
)
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (vla-put-Explodable obj :vlax-true))))) ;修改为可分解属性
(vl-catch-all-apply 'exp-blk (list en)) ;_ 炸块
)
)
((and (/= (dxf1 en 66) 1) ;;非属性块
(/= (vla-get-objectname obj) "AcDbMInsertBlock");;非多重插入块
(= (vla-get-objectname obj) "AcDbBlockReference") ;;普通块
(equal (vla-get-XScaleFactor obj) (vla-get-YScaleFactor obj) (vla-get-ZScaleFactor obj)) ;等比块
)
(sl-explo en)
)
((and ;炸开非属性块之外的 (非等比例块、多重插入块、无名块)
(/= (dxf1 en 66) 1) ;;非属性块
(or
(not (equal (vla-get-XScaleFactor obj) (vla-get-YScaleFactor obj) (vla-get-ZScaleFactor obj))) ;非等比
(= (vla-get-objectname obj) "AcDbMInsertBlock");;多重插入块
(wcmatch (dxf1 en 2) "`**") ;无名块
)
)
(m-blk-exp en)
)
((= (dxf1 en 66) 1) ;;属性块
(sl-a2t (ssadd en))
)
((and ;炸动态块,属性不只一个,转文字全删除
(vlax-property-available-p obj 'isdynamicblock)
(eq :vlax-true (vla-get-isdynamicblock obj))
)
(setq e (entlast))
(sl-a2t (ssadd en))
(setq ss (last_ent e))
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))))
(if (getstr nam) (entdel nam))
)
)
)
(setq n -1)
(if (setq ss (last_ent e0))
(while (setq nam (ssname ss (setq n (1+ n))))
(if (= (dxf1 nam 0) "INSERT") (exp-blk nam))
)
)
)
(if (null c:sl-tkgl)
(progn
(load (strcat sl-path0 "\\Support\\" "sl-tkgl.VLX"))
(exp-xclip-blk (ssadd en))
)
)
)
(progn ;参照
(setq kk
(sl:do1ordo2
(slmsg "外部参照!是否绑定->炸开?" "场把酚!琌竕﹚->秨?" "External reference! Bind ->Explode?")
(setq str1 (slmsg "->绑定->炸开" "->竕﹚->秨" "->bind->exp"))
(setq str2 (slmsg "放弃" "斌" "Cancel"))
)
)
(if (= kk str1)
(progn
(vla-bind (vla-item *BLKS* (dxf1 en 2)) :vlax-true)
(command "EXPLODE" en) ;必须如此
)
)
)
)
)
;;炸开嵌套块-----(一级)------
;;返回:炸开后选择集
(defun sl-explo (en / e nam ss)
(setq e (entlast))
(vl-catch-all-apply '(lambda () (command "EXPLODE" en)))
(if (setq ss (ssget "p" '((0 . "INSERT"))))
(repeat (sslength ss)
(setq nam (ssname ss 0))
(ssdel nam ss)
(if (/= (dxf1 nam 66) 1)
(sl-explo nam)
(sl-a2t (ssadd nam))
)
)
)
(setq ss (last_ent e))
ss
)
;;炸开非等比例块、多重插入块、无名块-----(一级)------
;;en: 块实体名
(defun m-blk-exp (en / lasten layer blkref)
;;分解嵌套块---------
(defun supperexplodeblock (obj parlst / origin x y z r insertpt copyent atts stylename dxf blkobj e0 txtobj tmp copys row col rowspc colspc)
(setq origin (vlax-3d-point '(0 0 0)))
(if (or (= "AcDbBlockReference" (vla-get-objectname obj)) (= "AcDbMInsertBlock" (vla-get-objectname obj)))
(progn
(setq x(vla-get-XScaleFactor obj) y (vla-get-YScaleFactor obj) z(vla-get-ZScaleFactor obj) r (vla-get-Rotation obj) Insertpt (vla-get-InsertionPoint obj))
(setq copyent (vlax-invoke *AcDocument* 'CopyObjects (sl-itemsall (vla-item (vla-get-blocks *AcDocument*) (vla-get-name obj))) *Model-Space*))
(vla-delete obj)
(setq parlst (cons (list x y z r Insertpt) parlst))
(foreach aobj copyent
(if (or (= "AcDbBlockReference" (vla-get-objectname aobj)) (= "AcDbMInsertBlock" (vla-get-objectname aobj)))
(supperexplodeblock aobj parlst)
(progn
(setq copyent (list aobj))
(mapcar
'(lambda (pars / x y z r insertpt blkobj e0)
(setq x (car pars) y(cadr pars) z(caddr pars) r (cadddr pars) Insertpt(last pars))
(setq blkobj (vla-add (vla-get-blocks *AcDocument*) origin "*U"))
(vlax-invoke *AcDocument* 'CopyObjects copyent blkobj)
(mapcar 'vla-Delete copyent)
(vla-insertblock *Model-Space* Insertpt (vla-get-name blkobj) x y z r)
(command "_.explode" (setq e0 (entlast)))
(vla-delete blkobj)
(setq copyent (ssget->vla-list (last_ent e0)))
)
parlst
)
)
)
)
)
(progn
(setq copyent (list obj))
(mapcar
'(lambda (pars / x y z r insertpt blkobj e0)
(setq x (car pars) y(cadr pars) z(caddr pars) r (cadddr pars) Insertpt (last pars))
(setq blkobj(vla-add (vla-get-blocks *AcDocument*) origin "*U"))
(vlax-invoke *AcDocument* 'CopyObjects copyent blkobj)
(mapcar 'vla-Delete copyent)
(vla-insertblock *Model-Space* Insertpt (vla-get-name blkobj) x y z r)
(command "_.explode" (setq e0 (entlast)))
(vla-delete blkobj)
(setq copyent (ssget->vla-list (last_ent e0)))
)
parlst
)
)
)
)
;;主程序
(if (= 'ename (type en))
(setq blkref (en2obj en))
(setqblkref en en (obj2en en))
)
(if
(and
(= "INSERT" (dxf1 en 0))
(not (= 4 (logand (cdr (assoc 70 (entget (tblobjname "block" (cdr (assoc 2 (entget en))))))) 4))) ;_ 非外部参照块
(/= (dxf1 en 66) 1) ;;非属性块
)
(supperexplodeblock blkref nil)
)
)
;炸开选择集属性块,属性转文字-----(一级)------
;(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 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)
)
)
)
;;炸属性块bnam----(一级)--------
;(slblka2t (car (entsel)))
(defun slblka2t (bnam / e_lst e attnam atdef nam obj str p h ly lt col ly0 lt0 col0 ang ss ss-layer ss-color ss-ltype)
(if (and (= (dxf1 bnam 0) "INSERT") (= (dxf1 bnam 66) 1) (setq obj (en2obj bnam)) (= (vla-get-hasattributes obj) :vlax-true))
(progn
(setq e_lst (sysvar '("QAFLAGS" "CMDECHO")))
(setvar "CMDECHO" 0)
(setvar "QAFLAGS" 0)
(setq ly (dxf1 bnam 8) lt (sl-linetype bnam) col (sl-getcolor bnam))
(setq attnam (entnext bnam) e (entlast))
(while (= "ATTRIB" (dxf1 attnam 0))
(setq p (e9pt attnam 5) str (dxf1 attnam 1) h (dxf1 attnam 40) ang (angle-sharp (dxf1 attnam 50)))
(if (/= "STAR" (dxf1 attnam 2))
(progn
(slmkwz str p (/ h slbl) ang 0.7 (dxf1 attnam 8) $hz (sl-getcolor attnam) "m")
(text:alignmod (entlast) "L")
(if (if-color)
(vla-put-color (en2obj (entlast)) (atoi (slsjqs)))
)
)
)
(setq attnam (entnext attnam))
)
(command "explode" bnam)
(setq ss-layer (ssadd) ss-color (ssadd) ss-ltype (ssadd) ss (last_ent e))
(while (setq nam (ssname ss 0))
(setq ly0 (dxf1 nam 8) col0 (dxf1 nam 62) lt0 (dxf1 nam 6))
(if (= (dxf1 nam 0) "ATTDEF" )
(sl-att-text nam) ;(entdel atdef)
(cond
((and (= ly0 "0")(/= ly0 ly))
(ssadd nam ss-layer)
)
((and (= col0 "0")(/= col0 col))
(ssadd nam ss-color)
)
((and (= lt0 "BYBLOCK") (/= lt0 lt))
(ssadd nam ss-ltype)
)
)
)
(ssdel nam ss)
)
(if (> (sslength ss-layer) 0)
(command"_.chprop" ss-layer "" "_LA" ly "")
)
(if (> (sslength ss-color) 0)
(slchcol ss-color col)
)
(if (> (sslength ss-ltype) 0)
(command "_.chprop" ss-ltype "" "_LT" lt "")
)
(mapcar 'eval e_lst)
)
)
(princ)
)那么好了，本坛的”超级炸弹“，能不能出来？我看够呛！
我是没有，否则，我势必要发出来的，你别不要脸的，敢叫此名！
你也别不要脸的，随便回复我得帖子！你不懂，看看得了，
实在你闲的蛋疼，不如去巴黎体会没空调的桑拿！
你根本就不明白到底我说的啥个事！
;炸开(含有Xclip块)的实体集---(一级)----
(defun exp-xclip-blk (ss / file_path wmffile p1 p2 nam p0 e_lst lst d1 d2)
(defun slhas (TYPE_1 NAME)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list ((eval (read (strcat "vla-get-" TYPE_1))) *AcDocument*) NAME))
)
)
t
)
)
;;-------------------
(princ (slmsg "\n Xclip块裂解-->>" "\n Xclip遏吊秆-->>" "\ n Xclip block Explode-->"))
(setq file_path (strcat sl-path0 "\\tmp"))
(if (findfile file_path) (princ) (vxmakedirectory file_path))
(setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
(while (findfile (strcat wmffile ".wmf"))
(setq wmffile (strcat file_path "\\WMF_" (slsjqs)))
)
(setq lst (slget-box ss) p1 (car lst) p2 (cadr lst) d1 (distance p1 p2))
(setq e_lst (sysvar '("WMFBKGND" "TILEMODE")))
(setvar "WMFBKGND" 0);;清除底色
(if (slhas "LAYOUTS" "Temporary layout")
(princ)
(command "layout" "n" "Temporary layout") ;创建并切换布局
)
(command "_.layout" "s" "Temporary layout")
(setvar "tilemode" 0)
(command "erase" (ssget "X" '((0 . "VIEWPORT"))) "") ;删除所有布局视口
(command "mview" p1 p2)
(vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
(if (= (getvar "CVPORT") 1) (command "mspace")) ;激活视口;(command "pspace");切换到图纸空间
(vla-ZoomWindow *ACAD* (vlax-3d-point p1) (vlax-3d-point p2))
(if (not (vl-catch-all-error-p (vl-catch-all-apply '(lambda () (command "wmfout" wmffile ss "")))))
(progn
(sl:erase ss) ;删除
(setvar "tilemode" 1) ;切换回模型空间
(if (slhas "LAYOUTS" "Temporary layout")
(command "_.layout" "D" "Temporary layout") ;删除临时布局
)
(command "_.wmfin" wmffile 1 1 1 0)
(setq nam (entlast) lst (e9pt nam nil) p0 (nth 4 lst) d2 (distance (car lst) (nth 8 lst)))
(command "SCALE" nam "" p0 (/ d1 d2) "_.MOVE" nam "" "non" p0 PAUSE)
(vl-catch-all-apply 'exp-blk (list nam));炸块
)
)
(mapcar 'eval e_lst)
(princ)
)
;;炸XCLIP块(备用)---
;;速度慢，结果还可以理想(exp-xclip-blkr (car (entsel "\n选择剪裁块:")))
(defun exp-xclip-blk--- (ss / ss1 nam nam1 e n pls)
(repeat (setq n (sslength ss))
(setq nam (ssname ss (setq n (1- n))))
(if (isxclip nam) ;是XCLIP块
(progn
(command "_.XCLIP" nam "" "P")
(setq e (entlast) pls (getpt (ssadd e)))
(command "_.XCLIP" nam "" "D")
(vl-catch-all-apply 'exp-blk (list nam));炸块
(vl-catch-all-apply 'slexpline (list (last_ent e)));线类裂解系统
(vl-catch-all-apply 'sl_break_with (list (ssadd e (last_ent e)) t));交点断开系统
(setq ss1 (last_ent e)) ;;炸断开后总集
(command "_.COPY" (ssget "WP" pls) "" "_non" '(0 0) "_non" '(0 0)) ;;原位拷贝
(entdel e)
(sl:erase ss1) ;删除
)
)
)
)
;;动态块ss 改为普通快-------
(defun DynBlk2blk (ss / lst n obj name blkdef blkref cnt)
(setq cnt 0)
(repeat (setq n (sslength ss))
(setq obj (en2obj (ssname ss (setq n (1- n)))))
(if (and
(vlax-property-available-p obj 'isdynamicblock)
(eq :vlax-true (vla-get-isdynamicblock obj))
)
(progn
(setq lst nil cnt (1+ cnt))
(vlax-for a (vla-item *BLKS* (vla-get-name obj))
(setq lst (cons a lst))
)
(setq blkdef
(vla-add *BLKS* (vlax-3d-point '(0 0 0)) "*U")
)
(vla-CopyObjects
*AcDocument*
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length lst)))
)
lst
)
)
blkdef
)
(setq name (vla-get-name blkdef))
(setq blkref
(vla-InsertBlock
(vlax-get-property *AcDocument*
(if (= 1 (getvar 'CVPORT))
'PaperSpace
'ModelSpace
)
)
(vla-get-InsertionPoint obj)
Name
(vla-get-XScaleFactor obj)
(vla-get-YScaleFactor obj)
(vla-get-ZScaleFactor obj)
(vla-get-Rotation obj)
)
)
(vla-put-layer blkref (vla-get-layer obj))
(vla-delete obj)
)
)
)
(princ (strcat (slmsg "\n ***共修改 " "\n ***э " "\n ***Co modification ") (itoa cnt) (slmsg " 个动态块***" " 笆篈遏***" " Num Dynamic blocks***")))
(princ)
)
镶嵌块能不能一起给炸了？如果不行还是棋差一招 jh3030912 发表于 2024-7-27 21:51
镶嵌块能不能一起给炸了？如果不行还是棋差一招
可以单独使用吗？
谢谢分享 不要耍“炸”，CAD转PDF，PDF再转CAD+OCR，玩事大吉。 GEGEYANG88 发表于 2024-7-28 21:33
不要耍“炸”，CAD转PDF，PDF再转CAD+OCR，玩事大吉。
如果变换后，原来的线类，文字，还保持完整，是可以的，因为还要进行深化设计。
但目前，关于PDF和CAD之间，恐怕并没有这么完美的存在。
扫描变矢量呢，目前，连扫描仪都难以见到了。
页:
[1]