图纸清理(瘦身)工具

sh_h

    工作中有时候会遇到从合作公司发来的超大图纸文件，多则几十甚至上百兆，
如果计算机硬件配置足够“硬”那也就无所谓了，但是对于配置一般的计算机而言，
开个几十甚至上百兆的文件可能就显得力不从心；

    今天无意中从Autodesk App Store搜到了一个专门清理图纸的工具，比CAD自带的PURGE
命令强好多，兴奋之余不敢独享，特分享给广大的坛友：
========================================================
(注意:仅支持CAD2014及以上版本，看好再下！清理前做好备份！！！)
========================================================
原文链接：Drawing Purge | AutoCAD | Autodesk App Store  
https://apps.autodesk.com/ACD/en ... Lang=en&os=Win32_64
========================================================
同时奉上我下载的，见附件：

白领坛主

炸开、整图，在网上搜集些，大家可以整合使用。

;;----------------------------------------------------------------------------

(defun C:T-EXPLODE(/ s p n l nam stlx r_zm70 c_zm71 r_dist_zm44 c_dist_zm45 e)
        ;; 炸开属性块，属性转文字
        (setq s nil)
        (if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 66 1))))
                (progn   
                        (vl-load-com)
                        (setq p(sslength s))
                        (setq n 0 )
                        (undobegin)         
                        (setq p(- p 1))
                        (while (<= n p)
                                (a2t (ssname s n))            
                                (setq n (+ n 1))
                                (undoend)
                        )
                )
        )
        ;; 炸开存在普通块、MTEXT字体，，，，，，，，，，
  (setq s nil)
  (if (setq s(ssget "X" (list (cons 0 "MTEXT,DIM*,TCH*,INSERT"))))   
                (progn      
                        (setq p(sslength s))
                        (setq n 0 )
                        (setq p (- p 1))
                        (while (<= n p)
                                (setq nam(ssname s n))
                                (command "EXPLODE" nam "")
                                (setq n (+ n 1))
                        )
                )
        )
        ;;转多重插入块为普通快
  (setvar "cmdecho" 0)
  (setq s nil)
  (if (setq s(ssget "X" (list (cons 0 "INSERT")(cons 100 "AcDbMInsertBlock"))))   
                (progn      
                        (setq p(sslength s))
                        (setq n 0 )
                        (setq p (- p 1))
                        (while (<= n p)
                                (setq nam(ssname s n))
                                (setq e (entget nam))
                                (setq stlx (cdr (assoc 0 e)))            
                                (setq r_zm70 (assoc 70 e))
                                (setq c_zm71 (assoc 71 e))
                                (setq r_dist_zm44 (assoc 44 e))
                                (setq c_dist_zm45 (assoc 45 e))
                                (setq e (subst (cons 44 0) r_dist_zm44 e))
                                (setq e (subst (cons 45 0) c_dist_zm45 e))
                                (setq e (subst (cons 70 0) r_zm70 e))
                                (setq e (subst (cons 71 0) c_zm71 e))
                                (setq e (subst (list 100 "AcDbBlockReference") (list 100 "AcDbMInsertBlock")

e))
                                (entmake e)
                                (entdel nam)
                                (setq n (+ n 1))
                        )
                )
        )
        (setvar "cmdecho" 1)
        (command "_.PURGE" "a" "*" "N")
        (command "-scalelistedit" "R" "Y" "E") ;;清理注释比例
        (command "regenall")
)

;;;文字替代,炸开MTEX,TEXT改双夹点;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun C:FS (/ eng chn sech tt1 tt2 a1 a2 hh s p n pt1 x y)
        (setvar "REGENMODE" 0)
;;;;;;图中所有TEXT字体改双夹点

  (setq x 0)         
  (setq y 4)
        (while (<= x y)
                (if (setq s(ssget "X" (list (cons 0 "TEXT")(cons 72 x))))
                        (progn
                                (setq p(sslength s))
                                (setq n 0)         
                                (setq p (- p 1))
                                (while (<= n p)
                                        (setq pt1(entget (ssname s n)))
                                        (setq pt1(cdr(assoc -1 pt1)))
                                        (vl-cmdf "_.JustifyText" pt1 "" "F")
                                        (setq n (+ n 1))
                                )
                        )
                )
    (setq x (+ x 1))
        )
        (setvar "REGENMODE" 1)
        (setq s nil)
       
        ;;;;;;;;;;;;;;文字替代乱码
       
  (if (= "" eng)(setq eng "txt"))
  (if (= "" chn)(setq chn "hztxt"))
  (setq sech (tblnext "style" t))
  (while sech
    (setq tt1 (cdr(assoc 3 sech)) tt2 (cdr(assoc 4 sech)))
    (if (or (<= (strlen tt1) 4)
        (/= "." (strcase(substr tt1 (- (strlen tt1) 3) 1)))        
                                )
        (setq tt1 (strcat tt1 ".shx"))
    )
    (if (or (<= (strlen tt2) 4)
        (/= "." (strcase(substr tt2 (- (strlen tt2) 3) 1)))
                                )
        (if (/= "" tt2)(setq tt2 (strcat tt2 ".shx")))
    )
    (if (/= ".TTF" (strcase(substr tt1 (- (strlen tt1) 3) 4)))
      (progn
        (if (null (findfile tt1))(setq a1 eng)(setq a1 tt1))
        (if (= "" tt2)
          (setq a2 "")
          (if (null (findfile tt2))(setq a2 chn)(setq a2 tt2))
        )
        (setq hh (strcat a1 "," a2))
        (command "_style" (cdr(assoc 2 sech)) hh "" "" "" "" "" "")
      )
      (if (null (findfile tt1))(command "_style" (cdr(assoc 2 sech)) (strcat eng "," chn) "" "" "" "" "" ""))
    )
    (setq sech (tblnext "style"))
  )
        (command "_.PURGE" "a" "*" "N")
        (command "-scalelistedit" "R" "Y" "E") ;;清理注释比例
        (command "regenall")  
)

abenmao168

好，感谢分享

longer1000

好啊！感谢

longer1000

好啊！感谢。。。。

yjf247606

谢谢楼主，辛苦了。

liunian0524

感谢楼主分享

yzhyxh

knife0930

感谢楼主分享

18932292002

谢谢楼主分享

神通不敌天数

谢谢谢谢了

sjj

是否可以不打开图形时使用？

sjj

不支持LT版本？

lzy1979

真的侧是不错的

hasky

感谢分享啦