数字切换图层

甜兮兮

不错  谢谢分享

andyzha

小毛草 发表于 2022-6-24 15:22

学习了，这样用起来比较方便。

atone

明经有个tcset的图层切换工具，非常不错

yefei812678

感谢大神分享感谢大神分享

gwar

感谢大佬分享

atone

atone 发表于 2024-2-15 08:54
明经有个tcset的图层切换工具，非常不错

http://bbs.mjtd.com/forum.php?mo ... amp;fromuid=7331526

zm880928

楼主，你这个怎么设置图层切换后，不随层啊

huxu823

panliang9 发表于 2022-2-18 08:48
不错，这个可以扩展一下。
1、在选中对象的前提下下，输入命令则将对象切换到该数字图层。
2、没有选中对 ...

2. ;;加载线型
   
3. (defun JZXX ()
   
4.   (or (TBLSEARCH "LTYPE" "CENTER,DASHED,FENCELINE1,FENCELINE2,PHANTOM")    ;搜索是否存在线型
   
5.     (vl-catch-all-apply
   
6.       'vla-load
   
7.       (list (vla-get-Linetypes
   
8.             (vla-get-ActiveDocument (vlax-get-acad-object))
   
9.           )
   
10.           "CENTER,DASHED,FENCELINE1,FENCELINE2,PHANTOM"
    
11.           (findfile "acadiso.lin")
    
12.       )                                                                    ;不存在则加载线型
    
13.     )
    
14.   )
    
15. )
    
16. 
    
17. (defun li-xjtc (cm ys xx xk dy / ss lts )
    
18.     (JZXX) ;加载线型
    
19.     (Princ "\<<<<图层切换程序>>>>")
    
20.     (setvar "cmdecho" 0)
    
21.     (if        (= (tblsearch "layer" cm) nil)
    
22.       (entmake
    
23.         (list
    
24.                       '(0 . "LAYER")
    
25.                       '(100 . "AcDbSymbolTableRecord")
    
26.                       '(100 . "AcDbLayerTableRecord")
    
27.                       '(70 . 0)        ;图层状态
    
28.                       (cons 2 cm)      ;图层名称
    
29.                       (cons 62 ys)     ;图层颜色
    
30.                       (cons 6 xx)      ;图层线型
    
31.                       (cons 370 xk)    ;图层线宽：100=1, 15=0.15, 18=0.18, -3=默认
    
32.                       (cons 290 dy)    ;0-不打印，1-打印
    
33.         )
    
34.       )
    
35.     )
    
36.     (setq ss (ssget))
    
37.     (if (= ss nil)
    
38.       (setvar "clayer" cm)                                                 ;没有对象就切换至指定图层
    
39.       (command "chprop" ss "" "la" cm "c" "bylayer" "lt" "bylayer" "")     ;有对象就将对象改至指定图层
    
40.     )
    
41.     (princ)
    
42. )
    
43. 
    
44. ;;;主程序
    
45. (defun c:00 (/) (li-xjtc "0" 7 "continuous" -3 1))              ;切换至 "0" 图层
    
46. (defun c:01 (/) (li-xjtc "01-DIM" 3 "continuous" 18 1))         ;切换至 "01-DIM" 图层
    
47. (defun c:02 (/) (li-xjtc "02-TXT" 7 "continuous" -3 1))         ;切换至 "02-TXT" 图层
    
48. (defun c:03 (/) (li-xjtc "03-Center" 1 "CENTER" 15 1))          ;切换至 "03-Center" 图层
    
49. (defun c:04 (/) (li-xjtc "04-Hidden" 8 "DASHED" -3 1))          ;切换至 "04-Hidden" 图层
    
50. (defun c:05 (/) (li-xjtc "05-Hatch" 2 "continuous" -3 1))       ;切换至 "05-Hatch" 图层

;;加载线型<br /> (defun JZXX ()<br />   (or (TBLSEARCH "LTYPE" "CENTER,DASHED,FENCELINE1,FENCELINE2,PHANTOM")    ;搜索是否存在线型<br />     (vl-catch-all-apply<br />       'vla-load<br />       (list (vla-get-Linetypes<br />             (vla-get-ActiveDocument (vlax-get-acad-object))<br />           )<br />           "CENTER,DASHED,FENCELINE1,FENCELINE2,PHANTOM"<br />           (findfile "acadiso.lin")<br />       )                                                                    ;不存在则加载线型<br />     )<br />   )<br /> )<br /> <br /> (defun li-xjtc (cm ys xx xk dy / ss lts )<br />     (JZXX) ;加载线型<br />     (Princ "\<<<<图层切换程序>>>>")<br />     (setvar "cmdecho" 0)<br />     (if        (= (tblsearch "layer" cm) nil)<br />       (entmake <br />         (list<br />                       '(0 . "LAYER")<br />                       '(100 . "AcDbSymbolTableRecord")<br />                       '(100 . "AcDbLayerTableRecord")<br />                       '(70 . 0)        ;图层状态<br />                       (cons 2 cm)      ;图层名称<br />                       (cons 62 ys)     ;图层颜色<br />                       (cons 6 xx)      ;图层线型<br />                       (cons 370 xk)    ;图层线宽：100=1, 15=0.15, 18=0.18, -3=默认<br />                       (cons 290 dy)    ;0-不打印，1-打印<br />         )<br />       )<br />     )<br />     (setq ss (ssget))<br />     (if (= ss nil)<br />       (setvar "clayer" cm)                                                 ;没有对象就切换至指定图层<br />       (command "chprop" ss "" "la" cm "c" "bylayer" "lt" "bylayer" "")     ;有对象就将对象改至指定图层<br />     )<br />     (princ)<br /> )<br /> <br /> ;;;主程序<br /> (defun c:00 (/) (li-xjtc "0" 7 "continuous" -3 1))              ;切换至 "0" 图层<br /> (defun c:01 (/) (li-xjtc "01-DIM" 3 "continuous" 18 1))         ;切换至 "01-DIM" 图层<br /> (defun c:02 (/) (li-xjtc "02-TXT" 7 "continuous" -3 1))         ;切换至 "02-TXT" 图层<br /> (defun c:03 (/) (li-xjtc "03-Center" 1 "CENTER" 15 1))          ;切换至 "03-Center" 图层<br /> (defun c:04 (/) (li-xjtc "04-Hidden" 8 "DASHED" -3 1))          ;切换至 "04-Hidden" 图层<br /> (defun c:05 (/) (li-xjtc "05-Hatch" 2 "continuous" -3 1))       ;切换至 "05-Hatch" 图层

z312144636

很好用感谢!!!!