Guest Posted August 28, 2015 Share Posted August 28, 2015 I find this lisp that frozen layers in viewports ;;; vpf.lsp Viewport Layer Freeze ;;; ;;; ARGUMENTS ;;; none ;;; ;;; USAGE ;;; vpf ;;; ;;; PLATFORMS ;;; 2000+ ;;; ;;; AUTHOR ;;; Copyright© 2005-2007 Charles Alan Butler ;;; TheSwamp.org ;;; ;;; VERSION ;;; 3.2 May 17, 2006 ;;; ;;; This routine will Freeze the layer of a selected entity in ALL tabs ;;; and ALL viewports except the active viewport , selected layers are ;;; frozen while selecting & restored in the active viewport ;;; ;;; If you run the routine in model space it will freeze in ALL viewports ;;; ;;; YOU MAY USE THIS CODE ONLY FOR *NON-COMMERCIAL* ;;; PURPOSES AND ONLY IF YOU RETAIN ;;; THIS HEADER COMPLETE AND UNALTERED ;;; you must contact me if you want to use it commercially ;;; ;;====== Main Lisp Routine ======= (defun c:vpf (/ oldcmd vpflag sel-vport entvport pik str laylist ms layout c-tab *error*) ;; error function (defun *error* (msg) (if (not (member msg '("console break" "Function cancelled" "quit / exit abort")) ) (princ (strcat "\nError: " msg)) ) (if (/= laylist "") (if ms (command ".-layer" "thaw" laylist "") (command ".vplayer" "t" laylist "All" "" ; reset selectd layers ".pspace") ) ) (setvar "CMDECHO" oldcmd) (princ) ) ;end error function (setq oldcmd (getvar "CMDECHO") c-tab (getvar "ctab")) (setvar "CMDECHO" 0) (if (= (getvar "TileMode") 1) ; in model space ;;------------------------------------------------ (progn (prompt "\n**** Layers chosen will be frozen in all viewports.") (setq ms t) ) ;;------------------------------------------------ (progn ;else in a layout (setq vpflag (getvar "cvport")) ; get viewport # (while (= vpflag 1) ; No active viewport, Loop until one is picked (setq sel-vport (car (entsel "\nSelect view port: "))) (if (= sel-vport nil) (alert "You must select a viewport\n --=< Try again! >=--") (progn (setq entvport (entget sel-vport)) (if (= (cdr (assoc 0 entvport)) "VIEWPORT") (progn (setq vpflag (cdr (assoc 69 entvport)) ) (command ".mspace") (setvar "cvport" vpflag) ) ; endif viewport ) ) ) ; endif cond sel-vport ) ;endwhile (= vpFlag 1) ) ;;------------------------------------------------ ) ; endif ;;================================ ;; Get Entity and Freeze Layer ;;================================ (command "undo" "begin") (while (setq pik (entsel "\nSelect an item whose layer to freeze: ")) (setq str (cdr (assoc 8 (entget (car pik))))) (if laylist (setq laylist (strcat laylist "," STR)) (setq laylist str) ) ;; Freeze selected layers for visual feedback (if ms (if (= str (getvar "clayer")) (alert "Layer current, will be frozen in viewports.") (command ".-layer" "freeze" str "") ) (command ".vplayer" "f" str "All" "") ) ) (cond ((/= laylist "") ; Freeze layers in ALL viewports and ALL TABs (setvar "TileMode" 0) ; Force Paper Space (foreach layout (vl-remove c-tab (layoutlist)) (setvar "ctab" layout) (command ".vplayer" "f" laylist "All" "") ) (if ms (progn (setvar "TileMode" 1) ; Back to Model Space (command ".-layer" "thaw" laylist "") ) (progn (setvar "ctab" c-tab) (setvar "cvport" vpflag) (command ".vplayer" "t" laylist "Current" "") ; restore working VP ) ) ) ((/= laylist "") (command ".vplayer" "t" laylist "Current" "") ; restore working VP ) ) ; end cond stmt (command "undo" "end") (setvar "CMDECHO" oldcmd) (princ) ) ; end defun (prompt "\nType VPF to run") (prin1) I try to change it to change it to thaw layes (defun c:vpt (/ oldcmd vpflag sel-vport entvport pik str laylist ms layout c-tab *error*) ;; error function (defun *error* (msg) (if (not (member msg '("console break" "Function cancelled" "quit / exit abort")) ) (princ (strcat "\nError: " msg)) ) (if (/= laylist "") (if ms (command ".-layer" "thaw" laylist "") (command ".vplayer" "t" laylist "All" "" ; reset selectd layers ".pspace") ) ) (setvar "CMDECHO" oldcmd) (princ) ) ;end error function (setq oldcmd (getvar "CMDECHO") c-tab (getvar "ctab")) (setvar "CMDECHO" 0) (if (= (getvar "TileMode") 1) ; in model space ;;------------------------------------------------ (progn (prompt "\n**** Layers chosen will be frozen in all viewports.") (setq ms t) ) ;;------------------------------------------------ (progn ;else in a layout (setq vpflag (getvar "cvport")) ; get viewport # (while (= vpflag 1) ; No active viewport, Loop until one is picked (setq sel-vport (car (entsel "\nSelect view port: "))) (if (= sel-vport nil) (alert "You must select a viewport\n --=< Try again! >=--") (progn (setq entvport (entget sel-vport)) (if (= (cdr (assoc 0 entvport)) "VIEWPORT") (progn (setq vpflag (cdr (assoc 69 entvport)) ) (command ".mspace") (setvar "cvport" vpflag) ) ; endif viewport ) ) ) ; endif cond sel-vport ) ;endwhile (= vpFlag 1) ) ;;------------------------------------------------ ) ; endif ;;================================ ;; Get Entity and Freeze Layer ;;================================ (command "undo" "begin") (while (setq pik (entsel "\nSelect an item whose layer to thaw: ")) (setq str (cdr (assoc 8 (entget (car pik))))) (if laylist (setq laylist (strcat laylist "," STR)) (setq laylist str) ) ;; Freeze selected layers for visual feedback (if ms (if (= str (getvar "clayer")) (alert "Layer current, will be thaw in viewports.") (command ".-layer" "thaw" str "") ) (command ".vplayer" "t" str "All" "") ) ) (cond ((/= laylist "") ; Freeze layers in ALL viewports and ALL TABs (setvar "TileMode" 0) ; Force Paper Space (foreach layout (vl-remove c-tab (layoutlist)) (setvar "ctab" layout) (command ".vplayer" "t" laylist "All" "") ) (if ms (progn (setvar "TileMode" 1) ; Back to Model Space (command ".-layer" "thaw" laylist "") ) (progn (setvar "ctab" c-tab) (setvar "cvport" vpflag) (command ".vplayer" "f" laylist "Current" "") ; restore working VP ) ) ) ((/= laylist "") (command ".vplayer" "f" laylist "Current" "") ; restore working VP ) ) ; end cond stmt (command "undo" "end") (setvar "CMDECHO" oldcmd) (princ) ) ; end defun (prompt "\nType VPT to run") (prin1) Is any faster way to do this two things with one lisp file ? Quote Link to comment Share on other sites More sharing options...
rlx Posted August 28, 2015 Share Posted August 28, 2015 (edited) I would use getkword at the beginning of the routine (initget "Freeze Thaw") (setq kw (getkword "\nFreeze or Thaw : ")) (if (= kw "Freeze")(setq CMD"Freeze")(setq CMD "Thaw")) and then replace "Freeze" or "Thaw" in your command function with CMD gr. Rlx ps I see the routine prompts thawed xx layer of frozen xx layers so maybe make a cmd_txt for that (if (= kw "Freeze") (setq CMD"Freeze" cmd_txt "Frozen") (setq CMD "Thaw" cmd_txt "Thawed")) Edited August 28, 2015 by rlx Quote Link to comment Share on other sites More sharing options...
Guest Posted August 28, 2015 Share Posted August 28, 2015 Hi rlx .Can you update the code because am not good in lisp? Quote Link to comment Share on other sites More sharing options...
rlx Posted August 28, 2015 Share Posted August 28, 2015 just add this code to the original vpf routine (defun c:ftvp ( / kw ) (initget "Freeze Thaw") (setq kw (getkword "\nFreeze or Thaw : ")) (if (= kw "Freeze")(c:vpf)(command ".vplayer" "thaw" pause "All" "")) (princ) ) call command with ftvp (freeze / thaw viewport) gr. Rlx Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.