关于“炸”

尘缘一生 · 发表于 2024-7-27 20:01:21

本帖最后由尘缘一生于 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))
(setq blkref 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)
)

;;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)) 
    (setq  blkref 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)
)

;炸开(含有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:49

镶嵌块能不能一起给炸了？如果不行还是棋差一招

jh3030912 · 发表于 2024-7-27 23:48:10

jh3030912 发表于 2024-7-27 21:51
镶嵌块能不能一起给炸了？如果不行还是棋差一招

可以单独使用吗？

蓦然语嫣 · 发表于 2024-7-28 16:26:48

谢谢分享

GEGEYANG88 · 发表于 2024-7-28 21:33:59

不要耍“炸”，CAD转PDF，PDF再转CAD+OCR，玩事大吉。

尘缘一生 · 发表于 2024-7-29 05:31:46

GEGEYANG88 发表于 2024-7-28 21:33
不要耍“炸”，CAD转PDF，PDF再转CAD+OCR，玩事大吉。

如果变换后，原来的线类，文字，还保持完整，是可以的，因为还要进行深化设计。
但目前，关于PDF和CAD之间，恐怕并没有这么完美的存在。
扫描变矢量呢，目前，连扫描仪都难以见到了。

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

[讨论] 关于“炸”

评分

点评