TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TJAM51 on February 27, 2006, 10:05:30 AM
-
Is is possible to isolate multiple layers through lisp?
-
EXPRESS TOOLS - LAYISO COMMAND?
-
Is is possible to isolate multiple layers through lisp?
Hopefully this will work for you
(defun sel-dial ()
;;;(setq fname (vl-filename-mktemp "liso.dcl"))
(setq fname (strcat (getvar "dwgprefix") "liso.dcl"))
(setq fn (open fname "w"))
(write-line
"sel_layer : dialog {" fn)
(write-line (strcat "label = " "\"" "SELECT LAYER(s) TO ISOLATE" "\"" ";") fn)
(write-line "spacer_1;" fn)
(write-line ":list_box {" fn)
(write-line (strcat "key = " "\"" "alist" "\"" ";") fn)
(write-line (strcat "label = " "\"" "Layer list" "\"" ";") fn)
(write-line "width=32;" fn)
(write-line "allow_accept=true;" fn)
(write-line "multiple_select=true;}" fn)
(write-line "spacer_0;" fn)
(write-line "spacer_0;" fn)
(write-line "ok_cancel;}" fn)
(close fn)
)
;;;(tablelist) from Afralisp.com
;(written by Michael Puckett)
(defun tablelist (s / d r)
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
);while
);defun
; THIS PROGRAM ISOLATES LAYERS
; BY CHOOSING FROM LAYER TABLE DIALOG WINDOW
(defun C:lis (/ all_layers choice dcl_ex dcl_id fname isol_list lyr_list)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(sel-dial)
(setq dcl_id (load_dialog fname))
(new_dialog "sel_layer" dcl_id)
(setq all_layers (reverse (tablelist "layer")))
(start_list "alist")
(mapcar 'add_list all_layers)
(end_list)
(action_tile "alist" "(setq choice $value)")
(start_dialog)
(unload_dialog dcl_id)
(done_dialog)
(vl-file-delete fname)
(if choice
(progn
(setq lyr_list
(mapcar (function (lambda (x)
(nth x all_layers)))
(read (strcat "(" choice ")"))))
(foreach lr lyr_list
(command "._-layer" "off" lr "")
)
)
(princ "\nNo layer selected!")
)
(setvar "cmdecho" 1)
(setvar "expert" 0)
(princ)
)
(prompt "\n")
(prompt "\t\t<<< Type LIS to load programm: >>> ")
(princ)
~'J'~
-
The routine is beautiful.....thanks so much
-
The routine is beautiful.....thanks so much
Sorry, my bad
I has confused with terms
See another one...
(defun sel-dial ()
;;;(setq fname (vl-filename-mktemp "liso.dcl"))
(setq fname (strcat (getvar "dwgprefix") "liso.dcl"))
(setq fn (open fname "w"))
(write-line
"sel_layer : dialog {" fn)
(write-line (strcat "label = " "\"" "SELECT LAYER(s) TO ISOLATE" "\"" ";") fn)
(write-line "spacer_1;" fn)
(write-line ":list_box {" fn)
(write-line (strcat "key = " "\"" "alist" "\"" ";") fn)
(write-line (strcat "label = " "\"" "Layer list" "\"" ";") fn)
(write-line "width=32;" fn)
(write-line "height=24;" fn)
(write-line "allow_accept=true;" fn)
(write-line "multiple_select=true;}" fn)
(write-line "spacer_0;" fn)
(write-line "spacer_0;" fn)
(write-line "ok_cancel;}" fn)
(close fn)
)
;;;(tablelist) from Afralisp.com
;(written by Michael Puckett)
(defun tablelist (s / d r)
(while
(setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
);while
);defun
; THIS PROGRAM ISOLATES LAYERS
; BY CHOOSING FROM LAYER TABLE DIALOG WINDOW
(defun C:lis1 (/ all_layers choice dcl_ex dcl_id fname isol_list lyr_list)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(sel-dial)
(setq dcl_id (load_dialog fname))
(new_dialog "sel_layer" dcl_id)
(setq all_layers (reverse (tablelist "layer")))
(setq all_layers (vl-remove-if
(function (lambda (x)
(member x '("0" "Defpoints"))))
all_layers))
(start_list "alist")
(mapcar 'add_list all_layers)
(end_list)
(action_tile "alist" "(setq choice $value)")
(start_dialog)
(unload_dialog dcl_id)
(done_dialog)
(vl-file-delete fname)
(if choice
(progn
(command "._-layer" "_th" "*" "_off" "*" "")
(setq lyr_list
(mapcar (function (lambda (x)
(nth x all_layers)))
(read (strcat "(" choice ")"))))
(setq isol_list (vl-remove-if-not (function (lambda (x)(member x lyr_list)))
all_layers))
(foreach lr isol_list
(command "._-layer" "on" lr "u" lr "s" lr"")
)
)
(princ "\nNo layer selected!")
)
(command "regenall")
(setvar "cmdecho" 1)
(setvar "expert" 0)
(princ)
)
(prompt "\n")
(prompt "\t\t<<< Type LIS1 to load programm: >>> ")
(princ)
~'J'~
-
Here is one I did a while back but works with on/off not Freeze/Thaw.
;; User pick of layers to remain ON
;; Picked layers turn off as picked, when Enter is pressed
;; picked layers are turned on and all others are turned off
(defun c:layon (/ laylst ent lname)
;;=====================================
;; Turn Layer On/Off -
;;=====================================
;; lst is a list of layer names
(defun layon (lst / doc lname)
(vl-load-com) ; load ActiveX support
;; set vlax pointers
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
;; step through each layer
(vlax-for for-item (vla-get-layers doc) ;(vla-GetExtensionDictionary)
;; get the name of the layer
(setq lname (vlax-get-property for-item 'name))
;; if the name is in the 'Keep On' list
(if (member lname lst)
;; turn layer on
(vlax-put-property
(vla-item (vla-get-layers doc) lname)
'layeron :vlax-true) ; layer ON
;; ELSE turn layer off
(vlax-put-property
(vla-item (vla-get-layers doc) lname)
'layeron :vlax-false) ; layer OFF
) ; endif
) ; vlax-for
) ; defun
;;===================
;; Start of Routine
;;===================
(command ".undo" "begin")
(prompt "\nLayers picked will turn off during selection.")
(setq laylst '())
(while (setq ent (nentsel "\nPick layers to keep on. Enter when done"))
(setq laylst (cons (setq lname (cdr (assoc 8 (entget (car ent))))) laylst))
(command "._Layer" "_Off" lname "")
) ; while
(and laylst (layon laylst)) ; Turn layers Off
(command ".undo" "end")
(princ)
) ;defun
(prompt "\n*-* Layers On loaded, Enter LayOn to run. *-*")
(princ)
-
I do not have words...
Thanks, Alan, is the really classics
Oleg
~'J'~
-
Well thank you sir. :-)
But no better than yours, just a different way to go.
-
Alan,
I like to learn from you, thanks :oops:
~'J'~