视口层冻结/解冻
我发现这个lisp冻结了视口中的图层;;; 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)
) ;endifviewport
)
)
) ;endif condsel-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)
) ;endifviewport
)
)
) ;endif condsel-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)
用一个lisp文件做这两件事有没有更快的方法？ 我会在例行程序开始时使用getkword
然后将命令函数中的“冻结”或“解冻”替换为CMD
gr.Rlx
ps我看到例程提示解冻xx层的冻结xx层，所以可能会为此制作一个cmd\u txt
(if (= kw "Freeze")
(setq CMD"Freeze" cmd_txt "Frozen")
(setq CMD "Thaw" cmd_txt "Thawed"))
你好，rlx。你能更新代码吗，因为我不擅长lisp？ 只需将此代码添加到原始的vpf例程中
4
使用ftvp调用命令（冻结/解冻视口）
gr.Rlx
页:
[1]