明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 4354|回复: 26

[源码] 这是一个可以归类图层的小插件

[复制链接]
发表于 2023-8-19 22:27:22 | 显示全部楼层 |阅读模式
本帖最后由 wuzhenif 于 2023-8-26 12:04 编辑

从别人那里传来的图,有些还要拷进自己的图里,看着那乱七八糟的图层,真的要吐,像我这样的强迫症,不能忍,真的不能忍,于是有了下面这个插件
这是一个按照线性,线宽,颜色,类型(文字、直线、多段线、圆、圆弧、填充),对这些图元进行图层归类的小插件,其中先判断是不是非打印层,如果是非打印层是不处理的,这个插件不是每个人都适用,仅作为参考。具体功能看一下后面的演示。
2023/08/21更新:
(一)、下面附件1 图层合并v1.1 优化了一些bug:
1.有的电脑无法加载DOTE线性,所以把加载DOTE线型改为加载CENTER线型,防止出错。
2.有的多段线是没有定义全局宽度的,比如箭头,碰到这种多段线就会出错,并打断程序运行,所以增加了一个错误处理,防止出错中止。
(二)、下面附件2 块中图元改层 v1.0 ,顾名思义,可以修改一个块中所有图元的图层,下面有演示,收一个明经币意思一下,为了以后更大的进步
2023/08/26重磅更新,图层合并v1.2,详附件3:
1)、增加块批量处理,程序更通用了
2)、优化一些bug

以下是源代码,无偿奉献给大家:

;;以下为主程序
;;获取选择集,并按条件替换图层
(defun c:tchb (/ ss i objname xobj type1)
  (setvar "cmdecho" 0)                        ; 关闭命令响应
  (vl-load-com)                                ;将 Visual LISP 扩展功能加载到 AutoLISP
  (setq acadobj (vlax-get-acad-object))
  (setq dwgobj (vla-get-ActiveDocument acadobj))
  (setq mspace (vla-get-ModelSpace dwgobj))
  (setq layersobj (vla-get-layers dwgobj))
                                        ;取得当前图形文件中的图层集合对象
  (setq ss (ssget))                        ;获取选集
  (addlay)                                ;新建图层

  (repeat (setq i (sslength ss))
    (setq objname (ssname ss (setq i (1- i))))
                                        ;ssname,选择集中的第一个元素的序号为零 (0)。如果成功,返回图元名
    (setq xobj (vlax-ename->vla-object objname))
    (judge-Plottable xobj)                ;子程序,判断是否为非打印层
    (if        (= Plot-result :vlax-false)
      (prin1)
      (classify-xobj xobj)                ;子程序,对单个图元进行归类
    )                                        ;end if
  )                                        ;end repeat
  (command "_.purge" "la" "" "n")
  (prin1)
)                                        ;end defun
(princ "请输入命令:TCHB ***作者:魂之彼岸***")

;;以下为建立新图层到layersobj中的子程序
(defun addlay ()
  (setq        list1 '(
                ("S_DETL" 7 "Continuous")
                ("THIN" 4 "Continuous")
                ("THICK" 6 "Continuous")
                ("REINL" 1 "Continuous")
                ("BEAM" 4 "DASHED")
                ("HATCH" 254 "Continuous")
                ("TEXT" 7 "CONTINUOUS")
                ("DIM" 3 "CONTINUOUS")
                ("DOTE" 1 "DOTE")
               )
  )
  (foreach ltype1 '("DOTE" "DASHED")
;;加载线型
    (if        (= (tblsearch "ltype" ltype1) nil)
      (command "_.linetype" "l" ltype1 "" "")
    )
  )                                        ;加载线型结束

  (foreach sobj        list1
    (setq layname (car sobj))
    (setq color1 (cadr sobj))
    (setq lt (caddr sobj))
    (setq a1 (tblsearch "layer" layname))
    (if        (= a1 nil)
      (progn
        (setq lay1 (vla-add layersobj layname))
        (vla-put-color lay1 color1)
        (vla-put-linetype lay1 lt)
      )
      (prin1)
    )
  )
)                                        ;end defun


;;;以下为确定对象是否具有指定特性
;;;(vlax-property-available-p xobj 'ConstantWidth)

;;;以下取得对象的AutoCAD图元类别名称   
;;;(vla-get-ObjectName xobj)

;;;以下获取对象的线型
;;;(vla-get-Linetype xobj)

;;以下获取对象真实线型,并按线型转换图层
(defun zhixian (xobj)
  (real-linetype xobj)
  (cond
    ((member linetype1
             '("DOTE"               "ACAD_ISO04W100"
               "CENTER"               "CENTER2"       "CENTERX2"
               "DASHDOT"       "DASHDOT2"      "DASHDOTX2"
              )
     )
     (progn
       (vla-put-Layer xobj "DOTE")
       (setq color4 (vla-get-Color xobj))
       (if (/= color4 256)
         (vla-put-Color xobj 256)
         (prin1)
       )
     )
    )
    ((member linetype1
             '("ACAD_ISO02W100"        "ACAD_ISO03W100" "DASHED"
               "DASHED2"        "DASHEDX2"         "HIDDEN"
               "HIDDEN2"        "HIDDENX2"
              )
     )
     (vla-put-Layer xobj "BEAM")
    )
    ((= linetype1 "CONTINUOUS")
     (vla-put-Layer xobj "THIN")
    )
  )
)                                        ;end defun

;;以下得出图元的真实颜色(数字)
(defun realcolor (xobj)
  (setq co (vla-get-Color xobj))        ;获得图元属性列表中的color值
  (cond
    ((= co 256)
     (progn
       (setq layername (vla-get-Layer xobj)) ;获得图元所在图层的名称   
       (setq lalist (tblsearch "layer" layername))
                                        ;查找图层列表中名为layername图层的属性点对列表
       (setq color2 (cdr (assoc 62 lalist))) ;获得图层的颜色数字
     )
    )
    ((/= co 256)
     (setq color2 co)
    )
  )
)                                        ;end defun


;;以下为获取多段线图元全局宽度,并按线宽和颜色归类
(defun duoduanxian (xobj)
  (realcolor xobj)
  (setq plwidth (vla-get-ConstantWidth xobj))
  (cond
    ((<= plwidth 5.0) (vla-put-Layer xobj "S_DETL"))
    ((and (> plwidth 5.0) (= color2 1))
     (vla-put-Layer xobj "REINL")
    )
    (t (vla-put-Layer xobj "THICK"))
  )
)                                        ;end defun

;;以下为取出所有图层列表的子程序
(defun getlayers (dwgobj)
  (setq laylist nil)
  (setq layersobj (vla-get-layers dwgobj))
                                        ;取得当前图形文件中的图层集合对象
  (vlax-for sobj layersobj
    (setq layname (vla-get-name sobj))
    (setq laylist (cons layname laylist))
  )
  (setq laylist (acad_strlsort laylist))
  (prin1 laylist)
)

;;以下得出图元的真实线型
(defun real-linetype (xobj)
  (setq rlt (vla-get-Linetype xobj))        ;获得图元属性列表中的linetype值
  (cond
    ((= rlt "BYLAYER")
     (progn
       (setq layername (vla-get-Layer xobj)) ;获得图元所在图层的名称   
       (setq ltlist (tblsearch "layer" layername))
                                        ;查找图层列表中名为layername图层的属性点对列表
       (setq linetype1 (cdr (assoc 6 ltlist))) ;获得图层的线型
     )
    )
    ((/= rlt "BYLAYER")
     (setq linetype1 rlt)
    )
  )
)


;;以下子程序判断图元所在图层是否非打印
(defun judge-Plottable (xobj)
  (setq layername (vla-get-Layer xobj))        ;获得图元所在图层的名称
  (setq layid (tblobjname "layer" layername))
                                        ;返回指定符号表(layer)其中某个条目(layername)的图元名(AutoLISP 类型的)
  (setq layidx (vlax-ename->vla-object layid))
                                        ;这是关键,将 AutoLISP 类型的对象名转换为 VLA 对象
  (setq Plot-result (vla-get-Plottable layidx)) ;判断图层是否可以打印
  (vlax-dump-object layidx)                ;列出对象特性
)


;;以下子程序对单个图元进行归类
(defun classify-xobj (xobj)
  (setq type1 (vla-get-ObjectName xobj))
  (cond
    ;;转角标注,对齐标注
    ((member type1
             '("AcDbRotatedDimension" "AcDbAlignedDimension")
     )
     (progn
       (vla-put-Layer xobj "DIM")
       (setq color3 (vla-get-Color xobj))
       (if (/= color3 256)
         (vla-put-Color xobj 256)
         (prin1)
       )
     )
    )
    ;;单行文字和多行文字
    ((member type1 '("AcDbText" "AcDbMText"))
                                        ;搜索表中是否包含某表达式,并从该表达式的第一次出现处返回表的其余部分,返回值不为空,就表示判断式成立,就会执行后面的函数
     (vla-put-Layer xobj "TEXT")
    )
    ;;填充
    ((= type1 "AcDbHatch")
     (vla-put-Layer xobj "HATCH")
    )
    ;;多段线部分
                                        ;多段线分粗细,细的归入S_DETL,粗的按照颜色归类,红色归入REINL,其他归入THICK  
    ((= type1 "AcDbPolyline")
     (duoduanxian xobj)
    )
    ;;直线,分实线,虚线,点划线
    ((= type1 "AcDbLine")
     (zhixian xobj)
    )
    ;;圆弧
    ((= type1 "AcDbArc")
     (vla-put-Layer xobj "S_DETL")
    )
    ;;圆
    ((= type1 "AcDbCircle")
     (vla-put-Layer xobj "S_DETL")
    )
    (t
     (princ)
    )
  )                                        ;end cont
)                                        ;end defun







本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 2明经币 +2 收起 理由
cghdy + 1 很给力!
菜鸟初来乍到 + 1 日常送币支持

查看全部评分

 楼主| 发表于 2023-8-20 19:26:59 | 显示全部楼层
ikias 发表于 2023-8-20 19:16
我用了一下,怎么老是不成功呢

不知道啊,我也只是个菜鸟,可能你处理的东西比较复杂吧,目前还不支持图块的处理,如果你选择的东西里包括图块,可能就不行
 楼主| 发表于 2023-8-20 19:23:49 | 显示全部楼层
旧友 发表于 2023-8-20 17:45
大佬,您好。这个代码怎么使用啊?麻烦大佬方便的时候指导一下,非常感谢

我也是刚入门的菜鸟,代码复制下来,拷到文本里,把文本后缀改为.lsp,就可以用了
 楼主| 发表于 2023-8-21 18:01:41 | 显示全部楼层
〆看_淡点 发表于 2023-8-21 17:22
要价格对话框设置一下就好了, 标注 DIM。  文字TXT。  红色0 这样启用和不启用。、

很好的建议
发表于 2023-8-19 22:48:00 | 显示全部楼层
谢谢分享源码
发表于 2023-8-20 00:08:58 | 显示全部楼层
谢谢分享源码
发表于 2023-8-20 07:01:53 | 显示全部楼层
非常好的软件
发表于 2023-8-20 08:04:51 | 显示全部楼层
感谢分享源码。
发表于 2023-8-20 10:14:52 | 显示全部楼层

感谢分享源码。
发表于 2023-8-20 10:55:32 | 显示全部楼层
感谢分享源码
发表于 2023-8-20 11:56:08 | 显示全部楼层
感谢分享,还挺实用的
发表于 2023-8-20 14:56:17 | 显示全部楼层
你好!这个功能很厉害
 楼主| 发表于 2023-8-20 16:55:47 | 显示全部楼层
陨落 发表于 2023-8-20 14:56
你好!这个功能很厉害

暂时还不支持图块的处理,还在学习中,努力把块处理完善了就完美了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-22 04:48 , Processed in 0.206060 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表