;=======================================================;
; VPFRZ.LSP by Michael Bulatovich April 24,2003 ;
; http://www.michaelbulatovich.ca ;
; ;
; A modified version of BNSLAYER.LSP ;
; Copyright (C) 1997 by Autodesk, Inc. ;
; Created 2/21/97 by Dominic Panholzer ;
; ;
; A point-and-freeze routine to freeze layers ;
; floating viewports by picking an object on ;
; the desired layer. ;
; ;
;=======================================================;

(defun C:vpfrz
(/ NOEXIT BLKLST CNT EN PMT ANS LAY NEST BLKLST oldexpert)

(setq oldexpert (getvar "expert"))
(setvar "cmdecho" 0)
(setvar "expert" 0)
(if (not opt)
(setq opt "2")
)
(setq NOEXIT T)
(setq CNT 0)
(while NOEXIT
(initget "Options Undo")
(setq EN
(nentsel
"\nSelect an object on the layer to be frozen in it's viewport or [Options/Undo]: "
)
)
; ------------------------- Set Options --------------------------

(While (= EN "Options")
(initget "1 2 3")
(cond
((= OPT "1")
(setq PMT
"\n1.\t
\n2.\tFreeze any sub-entity layers
\n3.\tFreeze Block insert layer & XREF subentity layers: "
)
)
((= OPT "2")
(setq PMT
"\n1.\tFreeze BLOCK and XREF insert layers
\n2.\t
\n3.\tFreeze BLOCK insert layer & XREF subentity layers:"
)
)
(T
(setq PMT
"\n1.\tFreeze BLOCK and XREF insert layers
\n2.\tFreeze any sub-entity layers
\n3.\t: "
)
)
)
(setq ANS (getkword PMT))
(cond
((null ANS)
(if (or (null OPT) (= OPT ""))
(progn
(setq OPT "3")
)
)
)
((= ANS "1")
(setq OPT "1")

)
((= ANS "2")
(setq OPT "2")

)
(T
(setq OPT "3")
)
)
(initget "Options")
(setq EN
(nentsel
"\nSelect an object on the layer to be frozen in it's viewport or [Options/Undo]: "
)
)
)
; ------------------------- Find Layer ---------------------------

(if (and EN (not (= EN "Undo")))
(progn
(setq BLKLST (last EN))
(setq NEST (length BLKLST))
(cond
((or (= OPT "2") ( (length BLKLST) 0)
(assoc 1(tblsearch "BLOCK" (cdr (assoc 2 (entget (car BLKLST))))))
)
(setq BLKLST (cdr BLKLST))
)
(if (> (length BLKLST) 0)
(setq LAY (entget (car BLKLST)))
(setq LAY (entget (car EN)))
)
)
)
; ------------------------ Process Layer -------------------------

(setq LAY (cdr (assoc 8 LAY)))
(setq ANS nil)
(if LAY
(progn
(command "vpLAYER" "F" LAY "" "")
(prompt (strcat "\nLayer " LAY " has been frozen in this viewport." ))
(setq CNT (1+ CNT))
)
(setq NOEXIT nil)
)
)
; -------------- Nothing selected or Undo selected ---------------

(progn
(if (= EN "Undo")
(if (> CNT 0)
(progn
(command "_.u")
(setq CNT (1- CNT))
)
(prompt "\nEverything has been undone.")
)
(setq NOEXIT nil)
)
)
)
)
(setvar "expert" oldexpert)
(setvar "cmdecho" 1)
)

(c:vpfrz)

Advertisements