;=======================================================;
;	VPFRZ.LSP by Michael Bulatovich April 24,2003   ;
;                    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<Freeze BLOCK and XREF insert layer>
          	     \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<Freeze any sub-entity layers>
                    \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<Freeze Block insert layer & XREF subentity layers>: "
	 )
	)
      )
      (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 EN) 3))
					
	   (setq LAY (entget (car EN)))	
	  )
	  ((= OPT "1")
	   (setq LAY (entget (car (reverse BLKLST)))))
	  (T
	   (setq BLKLST (reverse BLKLST))
	   (while
	     (and(> (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)
)