Jump to content

viewport Layers Frozen/Thawed


Guest

Recommended Posts

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 ?

Link to comment
Share on other sites

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 by rlx
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...