[编程交流] 视口层冻结/解冻

;;;   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)

(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)

(if (= kw "Freeze")
 (setq CMD"Freeze" cmd_txt "Frozen")
 (setq CMD "Thaw" cmd_txt "Thawed"))

4