[原创]一个图层工具

langjs

单位有好多ＣＡＤ的老图，没有按图层绘制比较乱，这个小程序作用是：新建几个标准图层，并把图纸中的图元按照不同类别归到不同图层中去。水平有限，程序写的有些臃肿，有需要的可以下载下来参考使用。

有好多人不明白这个程序是干啥的，我再解释一下吧：比如说，我们单位有好多N年前绘制的dwg格式的图纸，由于当年的绘图员制图不规范，把所有尺寸，线，圆，文字，虚线，中心线都绘制到0层了没有按照图层分类。现在这些图纸还要使用，看着不爽，所以就编写了这个小程序，目的是：执行这个程序，程序自动新建几个标准图层，然后自动把图纸里的尺寸，线，圆，文字，虚线，中心线按照类别规整到各自的标准图层里边去，颜色随层。比如文字就到文字图层里边去了，这样就规范了。后来做了个批量处理工具，我就一下子把单位的几千张图纸都处理好了。

网友让我贴图，实在贴不出来图啊


;;; =================================================================
;;; 图层工具（建一个标准图层，并把图纸中的图元归类到不同图层中去）
;;; 作者：langjs  　　　　命令：tcl　　　　　　　　　2011年1月24日
;;; =================================================================
(defun c:gl (/ chk_lay col ent ent1 i lay layer_info layers linetype lst lt ly_info ly_infos name snap ss ss1 ss2 ss3 ss4 ss5 ss6
               ssguol1 ssguol2 ssguol3 ssguol4 tmplist xianxing
            )                               ; 一次性建立多个层
  (defun tcl-1 (/ chk_lay col lay lst lt)
    (defun mklacolt (lay col lt / chk_lay)
      (if (= (tblsearch "layer" lay) nil)
        (command "layer" "new" lay "c" col lay "lt" lt lay "")
      )
    )
    (setvar "cmdecho" 0)
    (foreach lt '("CENTER" "HIDDEN"
       "DASHED" "phantom"
      )
      (if (= (tblsearch "ltype" lt) nil)
        (command "_linetype" "l" lt "" "")
      )
    )
    (foreach lst '(("剖面线层" 40
        "CONTINUOUS"
       )
       ("0" 7
        "Continuous"
       )
       ("1轮廓实线层" 7
        "Continuous"
       )
       ("2细线层" 4
        "Continuous"
       )
       ("3中心线层" 1
        "CENTER"
       )
       ("4虚线层" 6
        "DASHED"
       )
       ("5剖面线层" 2
        "Continuous"
       )
       ("6文字层 " 3
        "CONTINUOUS"
       )
       ("7标注层" 4
        "CONTINUOUS"
       )
       ("8符号标注层" 31
        "CONTINUOUS"
       )
       ("9双点划线层" 6
        "PHANTOM"
       )
       ("排图层 " 5
        "CONTINUOUS"
       )
       ("图框层 " 7
        "CONTINUOUS"
       )
       ("消隐层 " -5
        "CONTINUOUS"
       )
      )
      (mklacolt (car lst) (cadr lst) (caddr lst))
    )
    (princ)
  )
  (defun tcl-2 (ss / ent ent1 i name ss1 ss2 ss3 ss4 ssguol1 ssguol2 ssguol3 ssguol4)
    (setq ss1 (ssadd)
          ss2 (ssadd)
          ss3 (ssadd)
          ss4 (ssadd)
    )                                       ; 下面程序设置过滤虚线条件
    (setq ssguol1 '("ACAD_ISO03W100" "ACAD_ISO02W100"
           "DASHED" "DASHED2"
           "DASHEDX2" "HIDDEN"
           "HIDDEN2" "HIDDENX2"
          )
    )                                       ; 下面程序将虚线图层加入虚线过滤条件
    (setq ssguol1 (append
                    ssguol1
                    (tt-01 "ACAD_ISO03W100")
                    (tt-01 "ACAD_ISO02W100")
                    (tt-01 "DASHED")
                    (tt-01 "DASHED2")
                    (tt-01 "DASHEDX2")
                    (tt-01 "HIDDEN")
                    (tt-01 "HIDDEN2")
                    (tt-01 "HIDDENX2")
                  )
    )                                       ; 下面程序将选择集中随层的虚线图层中的线加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (and
            (member (cdr (assoc 8 ent1)) ssguol1)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
        (setq ss1 (ssadd ent ss1))
      )
      (setq i (+ 1 i))
    )                                       ; 下面程序将选择集中其他层的虚线图元加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (member (cdr (assoc 6 ent1)) ssguol1)
        (setq ss1 (ssadd ent ss1))
      )
      (setq i (+ 1 i))
    )                                       ; 下面程序设置中心线过滤条件
    (setq ssguol2 '("ACAD_ISO04W100" "ACAD_ISO08W100"
           "ACAD_ISO10W100" "CENTER"
           "CENTER2" "CENTERX2"
           "DASHDOT" "DASHDOTX2"
           "G" "J"
           "ZX"
          )
    )                                       ; 下面程序将中心线图层加入过滤条件
    (setq ssguol2 (append
                    ssguol2
                    (tt-01 "ACAD_ISO04W100")
                    (tt-01 "ACAD_ISO08W100")
                    (tt-01 "ACAD_ISO10W100")
                    (tt-01 "CENTER")
                    (tt-01 "CENTER2")
                    (tt-01 "CENTERX2")
                    (tt-01 "DASHDOT")
                    (tt-01 "DASHDOTX2")
                    (tt-01 "G")
                    (tt-01 "J")
                    (tt-01 "ZX")
                  )
    )                                       ; 下面程序将选择集中随层的中心线图层中的线加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (and
            (member (cdr (assoc 8 ent1)) ssguol2)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
        (setq ss2 (ssadd ent ss2))
      )
      (setq i (+ 1 i))
    )                                       ; 下面程序将选择集中其他层的中心线图元加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (member (cdr (assoc 6 ent1)) ssguol2)
        (setq ss2 (ssadd ent ss2))
      )
      (setq i (+ 1 i))
    )                                       ; 下面程序设置双点划线过滤条件
    (setq ssguol3 '("ACAD_ISO05W100" "ACAD_ISO12W100"
           "DIVIDE" "DIVIDE2"
           "DIVIDEX2" "PHANTOM"
           "PHANTOM2" "PHANTOMX2"
           "SD"
          )
    )                                       ; 下面程序将双点划线图层加入过滤条件
    (setq ssguol3 (append
                    ssguol3
                    (tt-01 "ACAD_ISO05W100")
                    (tt-01 "ACAD_ISO12W100")
                    (tt-01 "DIVIDE")
                    (tt-01 "DIVIDE2")
                    (tt-01 "DIVIDEX2")
                    (tt-01 "PHANTOM")
                    (tt-01 "PHANTOM2")
                    (tt-01 "PHANTOMX2")
                    (tt-01 "SD")
                  )
    )                                       ; 下面程序将选择集中随层的双点划线图层中的线加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (and
            (member (cdr (assoc 8 ent1)) ssguol3)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
        (setq ss3 (ssadd ent ss3))
      )
      (setq i (+ 1 i))
    )                                       ; 下面程序将选择集中其他层的双点划线图元加入选择集
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (member (cdr (assoc 6 ent1)) ssguol3)
        (setq ss3 (ssadd ent ss3))
      )
      (setq i (+ 1 i))
    )
    (repeat (setq i (sslength ss))
      (setq name (ssname ss (setq i (1- i))))
      (setq ss4 (ssadd name ss4))
    )
    (setq ssguol4 (append
                    ssguol1
                    ssguol2
                    ssguol3
                  )
    )
    (setq i 0)
    (while (< i (sslength ss))               ; 过滤
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (and
            (member (cdr (assoc 8 ent1)) ssguol4)
            (/= (cdr (assoc 0 ent1)) "INSERT")
            (= (assoc 6 ent1) nil)
          )
        (setq ss4 (ssdel ent ss4))
      )
      (setq i (+ 1 i))
    )                                       ; 过滤
    (setq i 0)
    (while (< i (sslength ss))
      (setq ent (ssname ss i))
      (setq ent1 (entget ent))
      (if (member (cdr (assoc 6 ent1)) ssguol4)
        (setq ss4 (ssdel ent ss4))
      )
      (setq i (+ 1 i))
    )
    (if (/= (sslength ss1) 0)
      (command "_.change" ss1 "" "p" "la" "4虚线层" "C" "ByLayer" "")
    )
    (if (/= (sslength ss2) 0)
      (command "_.change" ss2 "" "p" "la" "3中心线层" "C" "ByLayer" "")
    )
    (if (/= (sslength ss3) 0)
      (command "_.change" ss3 "" "p" "la" "9双点划线层" "C" "ByLayer" "")
    )
    (if (/= (sslength ss4) 0)
      (command "_.change" ss4 "" "p" "la" "0" "C" "ByLayer" "")
    )
  )                                       ; =================================================================
                                       ; 获取包含指定线型的图层
  (defun tt-01 (xianxing / layers)
    (setq layers '())
    (setq layers (get_layer_linetype xianxing))        ; 获取包含指定线型的图层
    layers
  )
  (defun get_layer (/ layer_info layers) ; 返回当前图纸中图层信息
    (setq layer_info (tblnext "layer" t))
    (while (/= layer_info nil)
      (setq layers (append
                     layers
                     (list layer_info)
                   )
      )
      (setq layer_info (tblnext "layer"))
    )
    layers
  )
  (defun get_layer_linetype (linetype / ly_info ly_infos tmplist) ; 提取包含指定线型的图层
    (setq ly_infos (get_layer))
    (foreach ly_info ly_infos
      (if (= linetype (substr (cdr (assoc 6 ly_info)) 1 (strlen linetype)))
        (setq tmplist (append
                        tmplist
                        (list (cdr (assoc 2 ly_info)))
                      )
        )
      )
    )
    tmplist
  )
  (vl-load-com)
  (setvar "cmdecho" 0)                       ; 关闭命令响应
  (if (setq ss (ssget '((0 . "TEXT,MTEXT,DIMENSION,POINT,HATCH,PLINE,LWPOLYLINE,LINE,ARC,CIRCLE,SPLINE,ELLIPSE"))))
    (progn
      (command ".UNDO" "BE")               ; 设置undo起点
      (setq snap (getvar "osmode"))    ; 关闭捕捉
      (setvar "osmode" 0)               ; (setq ss (ssget))
      (command "_.purge" "la" "" "n")
      (tcl-1)
      (setq ss1 (ssadd)
            ss2 (ssadd)
            ss3 (ssadd)
            ss4 (ssadd)
            ss5 (ssadd)
            ss6 (ssadd)
      )
      (repeat (setq i (sslength ss))
        (setq name (ssname ss (setq i (1- i))))
        (setq ent (entget name))       ;   (princ "\n====")
                                       ;    (princ ent)
        (setq type (cdr (assoc 0 ent)))
        (cond
          ((= type "DIMENSION")
            (setq ss1 (ssadd name ss1))
          )
          ((member type '("TEXT" "MTEXT"))
            (setq ss2 (ssadd name ss2))
          )
          ((= type "POINT")
            (setq ss3 (ssadd name ss3))
          )
          ((= type "HATCH")
            (setq ss4 (ssadd name ss4))
          )
          ((member type '("PLINE" "LWPOLYLINE"))
            (setq ss5 (ssadd name ss5))
          )
          ((member type '("LINE" "ARC"
                    "CIRCLE" "SPLINE"
                    "ELLIPSE"
                   )
           )
            (setq ss6 (ssadd name ss6))
          )
          (t
            (princ)
          )
        )
      )                                       ; (princ "\n====")
                                       ;  (princ (sslength ss6))
      (if (/= (sslength ss1) 0)
        (command "_.change" ss1 "" "p" "la" "7标注层" "C" "ByLayer" "")
      )
      (repeat (setq i (sslength ss1))
        (vlax-put-property (vlax-ename->vla-object (ssname ss1 (setq i (1- i)))) "textcolor" 3)
      )
      (if (/= (sslength ss2) 0)
        (command "_.change" ss2 "" "p" "la" "6文字层" "C" "ByLayer" "")
      )
      (if (/= (sslength ss3) 0)
        (command "_.erase" ss3 "")
      )
      (if (/= (sslength ss4) 0)
        (command "_.change" ss4 "" "p" "la" "5剖面线层" "C" "ByLayer" "")
      )
      (if (/= (sslength ss5) 0)
        (command "_.change" ss5 "" "p" "la" "1轮廓实线层" "C" "ByLayer" "")
      )
      (if (/= (sslength ss6) 0)
        (tcl-2 ss6)
      )
      (command "-layer" "c" 7 "0" "")
      (command "_.purge" "la" "" "n")
      (tcl-1)
      (princ "\n已将图元规整到标准图层。")
      (setvar "osmode" snap)               ; 恢复捕捉
      (command ".UNDO" "E")               ; 设置undo终点
    )
    (princ "\n没有找到要规整的图元。")
  )
  (princ)
)

ferious

感谢楼主。
有几个问题能否帮忙看下：
1，标注引线未增加进去；
2，如何将一份外界图纸，按照自己的图层规则，一次性全部一键规整。比如原图图层名中含有某些字样如TEXT全部归到指定标准图层，含有螺丝，fasten字眼全部归到紧固件层，含有虚线，dash,hidden等字眼全部归到虚线层等等。
3，全部规整后，再执行删除无对象图层，或者检测未转化彻底有残余的图层，然后再根据2中自行增加字眼，再次规整，直至全部达到标准图层。
4，用其他插件插入的块中，比如螺钉，如何也可以实现图层规整，并删除多余图层？

shcvip

langjs 发表于 2011-2-20 23:35
你需要什么样功能不太了解，加我QQ细谈，59509100，可以帮你改一下符合你的要求

有时候，别人的图纸过来，有时候，不要把别人的图层变成一个图层（灰掉），其中中心线层还是保留，会变成自己的中心线层。
这样可以解决，别人的众多的图层，一个个图改图层。
是否有这样的功能。

lrd1861

下来看看 支持一下

ymb0709

下来看看

xhq1954425

这么多下载的，支持回帖的不多……这不对呀！
我顶一下！

fengshi0519

谢谢
下来测试一下

zlq1318

什么功能啊  怎么不介绍

xiaoquansb

cad本身就有laytrans

yigcungang

谢谢楼主的分享。试一下

xiaxiang

支持一下，能否贴个动画让大家看得更明白一些

669423907

谢谢楼主的好资料！！！