征集CASS小程序

zhb236623

;;图层操作函数．．．这个程序来自网上．．．．．．

1. (DEFUN C:qb()　;;显示全部图层
   
2.         (command "layer" "on" "*" "")
   
3.         (COMMAND "LAYER" "THAW" "*" "")
   
4.         (COMMAND "LAYER" "U" "*" "")
   
5.     (PRINC)
   
6. )
   
7. 
   
8. ;;;-----关闭所选对象所在图层(复选)--------
   
9. (DEFUN  C:dqg ()
   
10.   (setvar "cmdecho" 0)
    
11.   (prompt"\nSelect entities to turn off:")
    
12.   (setq ss (ssget))
    
13.   (if (and ss (sslength ss) 0)
    
14.     (progn
    
15.      (setq ct 0 len (sslength ss) cl (getvar "clayer"))
    
16.      (command ".layer")
    
17.      (while (< ct len)
    
18.          (setq la (cdr (assoc 8 (entget (ssname ss ct)))))
    
19.          (if (/= cl la)(command "off" la)
    
20.                        (progn (prompt "\nThe layer")
    
21.                               (prompt la)
    
22.                               (prompt "is CURRENT!")
    
23.                        )  ;end of progn
    
24.          )                ;end of if
    
25.          (if (= old nil)(setq OLD la)(setq OLD (strcat OLD "," la)))
    
26.          (setq ct (1+ ct))
    
27.        )                  ;end of while
    
28.        (command"")
    
29.      )                  ;end of progn
    
30. )                      ;end of if
    
31. (princ)
    
32. (setvar "cmdecho" 0) (prin1)
    
33. )
    
34. 
    
35. ;;;------------------------关闭除所选对象所在图层外的所有层-------------------------------
    
36. (defun C:dq(/ ES EN EL A)
    
37. (Princ "Selected Entity(s) Layers ISOLate.")
    
38. (setq ES(ssget) A 0 EN "" EL nil FL nil)
    
39. (while (/= EN nil)
    
40. (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
    
41. (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
    
42. (repeat (- A 2)
    
43. (setq EN (cdr (assoc ' 8 (entget (car EL))))
    
44.   FL (strcat EN "," FL) EL (cdr EL)) )
    
45. (command "LAYER" "OFF" "*" "Y" "ON" (eval FL) "")
    
46. (princ))
    
47. 
    
48. 
    
49. ;;;----------------------------锁定所选对象所在图层---------------------------------
    
50. (defun C:dqs(/ ES EN EL A)
    
51. (Princ "Selected Entity(s) Layers Locked.")
    
52. (setq ES(ssget) A 0 EN "" EL nil FL nil)
    
53. (while (/= EN nil)
    
54. (setq EN (ssname ES A) EL (cons EN EL) A (1+ A)))
    
55. (setq EL (cdr EL) FL (cdr (assoc ' 8 (entget (car EL)))) EL (cdr EL))
    
56. (repeat (- A 2)
    
57. (setq EN (cdr (assoc ' 8 (entget (car EL))))
    
58.   FL (strcat EN "," FL) EL (cdr EL)) )
    
59. (command "LAYER" "LO" (eval FL) "")
    
60. (princ))

复制代码

tyson119

感谢版主的提议，感谢各位大虾的作品，收藏了。

kill_memory

高手多多啊！！！

hero1930

期待大家的作品

ch19897158

hychyysx 发表于 2011-4-21 08:11

正好需要修改等高线，谢啦

顶起小帐篷

{:soso_e113:}好多软件啊！学习学习

风飘飘

hao ````````````````

风飘飘

henhao ``````````````````

zhaotf2001

地信高手多呀，感谢分享

zzxconan

都是高手，学习一下，争取像大家考弄