图层孤立（Layer Isolate）

Lisphk

1. ;; Layer (un)ISOLATE
   
2. ;;
   
3. ;; File: laiso.lsp
   
4. ;;
   
5. ;;  Pseudo Code:
   
6. ;;
   
7. ;;  ISOLATE TOOL
   
8. ;;  ------------
   
9. ;;  o Select an ent(s) to isolate (leave on)
   
10. ;;  o Get layers from those ents
    
11. ;;  ~ Clean up list of layers by removing dups
    
12. ;;  o Get layers of dwg currently on
    
13. ;;  o remove list of layers to be left on
    
14. ;;  o set a global variable with layer list to be turned off
    
15. ;;  o if current layer is to be turned off...
    
16. ;;      o switch clayer to one of those in the isolate list
    
17. ;;  o itterate thru the list and turn each one off
    
18. ;;
    
19. 
    
20. (defun Select-Ent-lst ( )
    
21.   (
    
22.    ;; Itterate thru a Selection Set and return a list of items
    
23.    ;; used to allow end user to select some items they wish to keep
    
24.    (lambda (ss / lst cntr)
    
25.      (if (null cntr)
    
26.        (setq cntr 0) )
    
27.      (if (null lst)
    
28.        (setq lst '()) )
    
29.       (if (eq (type ss) 'PICKSET)
    
30.         (repeat (sslength ss)
    
31.            (setq lst (append lst (list (entget (ssname ss cntr)))))
    
32.            (setq cntr (1+ cntr)))
    
33.         '*ERROR* )
    
34.      lst
    
35.      )
    
36.     (ssget)) )
    
37. 
    
38. (defun Build-Layer-lst ( ent-lst )
    
39.   (mapcar
    
40.    ;; Build a list of layers to leave on
    
41.    '(lambda (x) (cdr (assoc 8 x))) ent-lst) )
    
42. 
    
43. (defun clean-lst ( my-lst / lst )
    
44. ;; Clean up a list of items; remove duplicates
    
45.      (foreach x my-lst
    
46.        (if (not (member x lst))
    
47.          (setq lst (cons x lst))))
    
48.      (reverse lst)
    
49. )
    
50. 
    
51. (defun Drawing-Layers-lst ( / )
    
52.   ;; create a list of layers in the drawing.
    
53.   ;; minus the ones turned off or frozen.
    
54.   (while (setq x (tblnext "LAYER" (not x)))
    
55.          (if (not (or (= (cdr (assoc 70 x)) 1) (< (cdr (assoc 62 x)) 0)))
    
56.            (setq mlst (append mlst (list (cdr (cadr x)))))
    
57.            )
    
58.          )
    
59.   mlst
    
60.   )
    
61. 
    
62. (defun rip-n-flip (lm lc / l-m cntr)
    
63.   (setq cntr (length lc) l-m (mapcar 'list lm))
    
64.   (while (> cntr -1)
    
65.     (setq l-m (subst nil (list (nth cntr lc)) l-m))
    
66.     (setq cntr (1- cntr))
    
67.     (apply 'append l-m)) )
    
68. 
    
69. (defun Lay (mode lst / layer)
    
70.   (foreach x lst
    
71.            (setq layer (entget (tblobjname "LAYER" x)))
    
72.            (cond
    
73.                ((and (null mode) (not (minusp (cdr (assoc 62 layer)))))
    
74.                   (setq layer (subst (cons 62 (1+ (~ (cdr (assoc 62 layer))))) (assoc 62 layer) layer)))
    
75.               ((and mode  (minusp (cdr (assoc 62 layer))))
    
76.                  (setq layer (subst (cons 62 (abs (cdr (assoc 62 layer)))) (assoc 62 layer) layer)))
    
77.               )
    
78.            (entmod layer)
    
79.            )
    
80.   (princ) )
    
81. 
    
82. ;;;===================================================================;
    
83. ;;; main procedures section                                           ;
    
84. ;;;===================================================================;
    
85. (defun c:laiso ( / ToIsolate-Layer-List)
    
86.   ;; (c:laiso)
    
87.   (setq ToIsolate-Layer-List
    
88.         (clean-lst
    
89.           (Build-Layer-lst
    
90.             (Select-Ent-lst))) )
    
91.   (setq
    
92.     *Layoff-layer-list*
    
93.     (rip-n-flip
    
94.       (Drawing-Layers-lst)
    
95.       ToIsolate-Layer-List))
    
96. 
    
97.   (if (member (getvar 'CLAYER) *Layoff-layer-list*)
    
98.     (progn
    
99.       (princ "\nCurrent layer scheduled to be turned off, switching layer...")
    
100.       (setvar 'clayer (car ToIsolate-Layer-List))) )
     
101.   (lay nil *Layoff-layer-list*) )
     
102. 
     
103. (defun c:laon ( )
     
104.   ;; (c:laon)
     
105.   (if *Layoff-layer-list*
     
106.     (progn
     
107.       (lay "on" *Layoff-layer-list*)
     
108.       (setq *Layoff-layer-list* nil))
     
109.     '*ERROR*:NoList)
     
110.   (princ) )
     

;; Layer (un)ISOLATE<br /> ;;<br /> ;; File: laiso.lsp<br /> ;;<br /> ;;  Pseudo Code:<br /> ;;<br /> ;;  ISOLATE TOOL<br /> ;;  ------------<br /> ;;  o Select an ent(s) to isolate (leave on)<br /> ;;  o Get layers from those ents<br /> ;;  ~ Clean up list of layers by removing dups<br /> ;;  o Get layers of dwg currently on<br /> ;;  o remove list of layers to be left on<br /> ;;  o set a global variable with layer list to be turned off<br /> ;;  o if current layer is to be turned off...<br /> ;;      o switch clayer to one of those in the isolate list<br /> ;;  o itterate thru the list and turn each one off<br /> ;;<br /> <br /> (defun Select-Ent-lst ( )<br />   (<br />    ;; Itterate thru a Selection Set and return a list of items<br />    ;; used to allow end user to select some items they wish to keep<br />    (lambda (ss / lst cntr)<br />      (if (null cntr)<br />        (setq cntr 0) )<br />      (if (null lst)<br />        (setq lst '()) )<br />       (if (eq (type ss) 'PICKSET)<br />         (repeat (sslength ss)<br />            (setq lst (append lst (list (entget (ssname ss cntr)))))<br />            (setq cntr (1+ cntr)))<br />         '*ERROR* )<br />      lst<br />      )<br />     (ssget)) )<br /> <br /> (defun Build-Layer-lst ( ent-lst )<br />   (mapcar<br />    ;; Build a list of layers to leave on<br />    '(lambda (x) (cdr (assoc 8 x))) ent-lst) )<br /> <br /> (defun clean-lst ( my-lst / lst )<br /> ;; Clean up a list of items; remove duplicates<br />      (foreach x my-lst<br />        (if (not (member x lst))<br />          (setq lst (cons x lst))))<br />      (reverse lst)<br /> )<br /> <br /> (defun Drawing-Layers-lst ( / )<br />   ;; create a list of layers in the drawing.<br />   ;; minus the ones turned off or frozen.<br />   (while (setq x (tblnext "LAYER" (not x)))<br />          (if (not (or (= (cdr (assoc 70 x)) 1) (< (cdr (assoc 62 x)) 0)))<br />            (setq mlst (append mlst (list (cdr (cadr x)))))<br />            )<br />          )<br />   mlst<br />   )<br /> <br /> (defun rip-n-flip (lm lc / l-m cntr)<br />   (setq cntr (length lc) l-m (mapcar 'list lm))<br />   (while (> cntr -1)<br />     (setq l-m (subst nil (list (nth cntr lc)) l-m))<br />     (setq cntr (1- cntr))<br />     (apply 'append l-m)) )<br /> <br /> (defun Lay (mode lst / layer)<br />   (foreach x lst<br />            (setq layer (entget (tblobjname "LAYER" x)))<br />            (cond<br />                ((and (null mode) (not (minusp (cdr (assoc 62 layer)))))<br />                   (setq layer (subst (cons 62 (1+ (~ (cdr (assoc 62 layer))))) (assoc 62 layer) layer)))<br />               ((and mode  (minusp (cdr (assoc 62 layer))))<br />                  (setq layer (subst (cons 62 (abs (cdr (assoc 62 layer)))) (assoc 62 layer) layer)))<br />               )<br />            (entmod layer)<br />            )<br />   (princ) )<br /> <br /> ;;;===================================================================;<br /> ;;; main procedures section                                           ;<br /> ;;;===================================================================;<br /> (defun c:laiso ( / ToIsolate-Layer-List)<br />   ;; (c:laiso)<br />   (setq ToIsolate-Layer-List<br />         (clean-lst<br />           (Build-Layer-lst<br />             (Select-Ent-lst))) )<br />   (setq<br />     *Layoff-layer-list*<br />     (rip-n-flip<br />       (Drawing-Layers-lst)<br />       ToIsolate-Layer-List))<br /> <br />   (if (member (getvar 'CLAYER) *Layoff-layer-list*)<br />     (progn<br />       (princ "\nCurrent layer scheduled to be turned off, switching layer...")<br />       (setvar 'clayer (car ToIsolate-Layer-List))) )<br />   (lay nil *Layoff-layer-list*) )<br /> <br /> (defun c:laon ( )<br />   ;; (c:laon)<br />   (if *Layoff-layer-list*<br />     (progn<br />       (lay "on" *Layoff-layer-list*)<br />       (setq *Layoff-layer-list* nil))<br />     '*ERROR*:NoList)<br />   (princ) )<br />