图层控制程序 源码 网上已经很多了 这个自己弄的

zhuquanmao

1. 
   
2. ;;; 解锁层
   
3. (defun c:Lay_ul (/ ssa index n entity)
   
4.   (setvar "cmdecho" 0)
   
5.   (setq ssa (ssget))
   
6.   (setq n (sslength ssa))
   
7.   (setq index (- n 1))
   
8.   (repeat n
   
9.     (setq entity (ssname ssa index))
   
10.     (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")
    
11.     (setq index (1- index))
    
12.   )
    
13.   (princ)
    
14. )
    
15. ;;; 锁定层
    
16. (defun c:Lay_ll (/ ssa index n entity)
    
17.   (setvar "cmdecho" 0)
    
18.   (princ "\n请注意：被选中的对象所在层将被锁定")
    
19.   (setq ssa (ssget))
    
20.   (setq n (sslength ssa))
    
21.   (setq index (- n 1))
    
22.   (repeat n
    
23.     (setq entity (ssname ssa index))
    
24.     (command "-layer" "lo" (cdr (assoc 8 (entget entity))) "")
    
25.     (setq index (1- index))
    
26.   )
    
27.   (princ)
    
28. )
    
29. ;;; 解冻层
    
30. (defun c:Lay_tl (/ ss)
    
31.   (setvar "cmdecho" 0)
    
32.   (command "-layer" "t" "*" "")
    
33.   (princ)
    
34. )
    
35. ;;; 锁住其他层
    
36. (defun c:Lay_lo (/ ssa index n entity chklay)
    
37.   (prompt "锁定其他层")
    
38.   (setvar "cmdecho" 0)
    
39.   (command "-layer" "lo" "*" "")
    
40.   (setq ssa (ssget))
    
41.   (setq n (sslength ssa))
    
42.   (setq index (- n 1))
    
43.   (repeat n
    
44.     (setq entity (ssname ssa index))
    
45.     (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")
    
46.     (command "-layer" "u" (strcat (cdr (assoc 8 (entget entity))) "*") "")
    
47.     (setq index (1- index))
    
48.   )
    
49.   (princ)
    
50. )
    
51. ;;; 解锁所有层
    
52. (defun c:Lay_ua (/ ss)
    
53.   (setvar "cmdecho" 0)
    
54.   (command "-layer" "u" "*" "")
    
55.   (princ)
    
56. )
    
57. ;;; 打开指定层
    
58. (defun c:Lay_olcc (/ cname)
    
59.   (setvar "cmdecho" 0)
    
60.   (command "-layer" "off" "*" "y" "")
    
61.   (setq cname (getstring "\n输入想打开的层: "))
    
62.   (command "-layer" "on" (strcat "*" cname "*") "")
    
63.   (princ)
    
64. )
    
65. ;;; 打开所有层
    
66. (defun c:Lay_ol (/ ss)
    
67.   (setvar "cmdecho" 0)
    
68.   (command "-layer" "on" "*" "")
    
69.   (princ)
    
70. )
    
71. ;;; 设当前层为embed
    
72. (defun c:Lay_ef (/)
    
73.   (setvar "cmdecho" 0)
    
74.   (setq chklay (tblsearch "layer" "EMBED"))
    
75.   (if (= chklay nil)
    
76.     (progn
    
77.       (command "-LAYER" "N" "EMBED" "C" "151" "EMBED" "")
    
78.       (command "-LAYER" "s" "EMBED" "")
    
79.     )
    
80.     (command "-LAYER" "s" "EMBED" "")
    
81.   )
    
82.   (princ)
    
83. )
    

<br /> ;;; 解锁层<br /> (defun c:Lay_ul (/ ssa index n entity)<br />   (setvar "cmdecho" 0)<br />   (setq ssa (ssget))<br />   (setq n (sslength ssa))<br />   (setq index (- n 1))<br />   (repeat n<br />     (setq entity (ssname ssa index))<br />     (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")<br />     (setq index (1- index))<br />   )<br />   (princ)<br /> )<br /> ;;; 锁定层<br /> (defun c:Lay_ll (/ ssa index n entity)<br />   (setvar "cmdecho" 0)<br />   (princ "\n请注意：被选中的对象所在层将被锁定")<br />   (setq ssa (ssget))<br />   (setq n (sslength ssa))<br />   (setq index (- n 1))<br />   (repeat n<br />     (setq entity (ssname ssa index))<br />     (command "-layer" "lo" (cdr (assoc 8 (entget entity))) "")<br />     (setq index (1- index))<br />   )<br />   (princ)<br /> )<br /> ;;; 解冻层<br /> (defun c:Lay_tl (/ ss)<br />   (setvar "cmdecho" 0)<br />   (command "-layer" "t" "*" "")<br />   (princ)<br /> )<br /> ;;; 锁住其他层<br /> (defun c:Lay_lo (/ ssa index n entity chklay)<br />   (prompt "锁定其他层")<br />   (setvar "cmdecho" 0)<br />   (command "-layer" "lo" "*" "")<br />   (setq ssa (ssget))<br />   (setq n (sslength ssa))<br />   (setq index (- n 1))<br />   (repeat n<br />     (setq entity (ssname ssa index))<br />     (command "-layer" "u" (cdr (assoc 8 (entget entity))) "")<br />     (command "-layer" "u" (strcat (cdr (assoc 8 (entget entity))) "*") "")<br />     (setq index (1- index))<br />   )<br />   (princ)<br /> )<br /> ;;; 解锁所有层<br /> (defun c:Lay_ua (/ ss)<br />   (setvar "cmdecho" 0)<br />   (command "-layer" "u" "*" "")<br />   (princ)<br /> )<br /> ;;; 打开指定层<br /> (defun c:Lay_olcc (/ cname)<br />   (setvar "cmdecho" 0)<br />   (command "-layer" "off" "*" "y" "")<br />   (setq cname (getstring "\n输入想打开的层: "))<br />   (command "-layer" "on" (strcat "*" cname "*") "")<br />   (princ)<br /> )<br /> ;;; 打开所有层<br /> (defun c:Lay_ol (/ ss)<br />   (setvar "cmdecho" 0)<br />   (command "-layer" "on" "*" "")<br />   (princ)<br /> )<br /> ;;; 设当前层为embed<br /> (defun c:Lay_ef (/)<br />   (setvar "cmdecho" 0)<br />   (setq chklay (tblsearch "layer" "EMBED"))<br />   (if (= chklay nil)<br />     (progn<br />       (command "-LAYER" "N" "EMBED" "C" "151" "EMBED" "")<br />       (command "-LAYER" "s" "EMBED" "")<br />     )<br />     (command "-LAYER" "s" "EMBED" "")<br />   )<br />   (princ)<br /> )<br />

2548572928

感谢楼主分享源码

2548572928

感谢楼主无私分享

wowan1314

支持。

spp_wall

好像都没有删除指定图层

仲文玉

支持下源码，

zhuquanmao

spp_wall 发表于 2013-4-7 10:37
好像都没有删除指定图层

网上网友作品

1. (defun c:Lay_scc (/ et ln lay_name ss li)
   
2.   (princ "\n清除指定图层内的实体")
   
3.   (setq li (entsel "\n请选择指定图层内的任何一个实体<回车直接输入层名>:"))
   
4.   (if li
   
5.     (progn                               ; 选择一个实体
   
6.       (setq et (entget (nth 0 li)))
   
7.       (setq lay_name (cdr (assoc 8 et)))
   
8.     )
   
9.     (progn                               ; 直接输入层名，理想的办法是采用列表
   
10. 
    
11.       (princ "输入层名:")
    
12.       (while (= ln nil)
    
13.         (setq lay_name (getstring))
    
14.         (setq ln (cdr (assoc 2 (tblnext "layer" t))))
    
15.         (while (and
    
16.                  ln
    
17.                  (/= ln "%")
    
18.                )
    
19.           (if (/= ln lay_name)
    
20.             (setq ln (cdr (assoc 2 (tblnext "layer"))))
    
21.             (setq ln "%")               ; 如指定的图层名已存在，则设“%”标?
    
22.                                        ; ?
    
23.           )
    
24.         )
    
25.         (if (/= ln "%")                       ; 错误处理
    
26.           (princ "指定的图层不存在，请重新输入:")
    
27.         )
    
28.       )
    
29. 
    
30.     )
    
31.   )
    
32.   (setq ss (ssget "X" (list (cons 8 lay_name)))) ; 构造选择集
    
33.   (command "-layer" "u" lay_name "")   ; 图层解锁
    
34.   (command "ERASE" ss "")               ; 清除所有实体
    
35.   (princ "\n清除完毕！")
    
36.   (princ)
    
37. )

(defun c:Lay_scc (/ et ln lay_name ss li)<br />   (princ "\n清除指定图层内的实体")<br />   (setq li (entsel "\n请选择指定图层内的任何一个实体<回车直接输入层名>:"))<br />   (if li<br />     (progn                               ; 选择一个实体<br />       (setq et (entget (nth 0 li)))<br />       (setq lay_name (cdr (assoc 8 et)))<br />     )<br />     (progn                               ; 直接输入层名，理想的办法是采用列表<br /> <br />       (princ "输入层名:")<br />       (while (= ln nil)<br />         (setq lay_name (getstring))<br />         (setq ln (cdr (assoc 2 (tblnext "layer" t))))<br />         (while (and<br />                  ln<br />                  (/= ln "%")<br />                )<br />           (if (/= ln lay_name)<br />             (setq ln (cdr (assoc 2 (tblnext "layer"))))<br />             (setq ln "%")               ; 如指定的图层名已存在，则设“%”标?<br />                                        ; ?<br />           )<br />         )<br />         (if (/= ln "%")                       ; 错误处理<br />           (princ "指定的图层不存在，请重新输入:")<br />         )<br />       )<br /> <br />     )<br />   )<br />   (setq ss (ssget "X" (list (cons 8 lay_name)))) ; 构造选择集<br />   (command "-layer" "u" lay_name "")   ; 图层解锁<br />   (command "ERASE" ss "")               ; 清除所有实体<br />   (princ "\n清除完毕！")<br />   (princ)<br /> )

【KAIXIN】

支持，用VLA来实现，代码很简洁
http://bbs.mjtd.com/thread-99208-1-1.html

zhuquanmao

【KAIXIN】 发表于 2013-4-7 13:48
支持，用VLA来实现，代码很简洁
http://bbs.mjtd.com/thread-99208-1-1.html

偶不会vla 只会简单的lisp啊

开1心

CAD2006好像都用不了啊~奇怪中~~

品茗新秀

看一下,有欠缺,如选中图中图元,再选要将此图元进入后选的图元的图层中,

sicky111

对照一下，看跟我的有没有什么不同。