;|VPLOCKER.LSP by Paul Kirill, copyright 2002 Kirill Design - PC & CAD Consulting (KDCAD)

	This routine is freely given and may be freely distributed as long
	as the Kirill Design copyright and contact info remains intact.  There are
	no guarantees offered with this routine.  KDCAD is not responsible for loss
	of data or work	due to the use of this routine.

	If you have any questions or are interested in contracting for additional custom
	routines, email us at info@kdcad.com.

	NOTES:	VPLOCKER provides shortcuts for locking and unlocking viewports on the fly.
		Locked viewports are changed to CYAN color and unlocked are BYLAYER.

		Thanks to Shawn Evjen for the original Lock/Unlock concepts! |; 

;;**********COMMAND REVIEW*******************

(defun C:MYVPL ()
  (textscr)
  (princ "\n\n\n\n*************VPLOCKER COMMANDS******************
  	  \n   VL  = Lock all viewports in current layout
  	  \n   VU  = Unlock all viewports in current layout
  	  \n   VAL = Lock all viewports in all layouts\n\n\n\n\n")
  (princ)
  )
  
(princ "\nVPLOCKER.LSP c2002 KDCAD, inc.
	\nVPLOCKER.LSP loaded successfully.  Type MYVPL for command list.")



;;**********MVIEW LOCK*******************
(defun c:VPL (/ VPLST THISTAB VPS)
  (setq THISTAB (getvar "ctab"))
  (setq VPLST (ssget "x" (list (cons 0 "viewport") (cons 410 THISTAB))))
  (setq c -1)
  (if VPLST
  (repeat (sslength VPLST)
    (setq VPS (cdr (car (entget (ssname VPLST (setq c (1+ c)))))))
    (setq VLAOBJ (vlax-ename->vla-object VPS))
    (vlax-put-property VLAOBJ 'Color 4)
  ))
  (if (= (getvar "ctab") "Model")
    (princ "\n** Command not allowed in Model Tab **")
    (command "mview" "lock" "on" VPLST "")
  )
  (princ)
)




;;**********MVIEW UNLOCK*******************
(defun c:VPU (/ VPLST THISTAB VPS)
  (setq THISTAB (getvar "ctab"))
  (setq VPLST (ssget "x" (list (cons 0 "viewport") (cons 410 THISTAB))))
  (setq c -1)
  (if VPLST
  (repeat (sslength VPLST)
    (setq VPS (cdr (car (entget (ssname VPLST (setq c (1+ c)))))))
    (setq vlaobj (vlax-ename->vla-object VPS))
    (vlax-put-property vlaobj 'Color 256)
  ))
  (if (= (getvar "ctab") "Model")
    (princ "\n** Command not allowed in Model Tab **")
    (command "mview" "lock" "off" VPLST "")
  )
  (princ)
)


;;**********MVIEW LOCK IN ALL LAYOUTS*******************
(defun c:VPAL (/ THISTAB VPLIST)
  (setq THISTAB (getvar "CTAB"))
  (foreach LAYOUT (layoutlist)
    (setvar "CTAB" LAYOUT)
    (setq VPLST (ssget "x" (list (cons 0 "viewport"))))
    (setq c -1)
    (if VPLST
    (repeat (sslength VPLST)
      (setq VPS (cdr (car (entget (ssname VPLST (setq c (1+ c)))))))
      (setq vlaobj (vlax-ename->vla-object VPS))
      (vlax-put-property vlaobj 'Color 4)
    )
    (command "mview" "lock" "on" VPLST "")
  ))
  (setvar "CTAB" THISTAB)
  (princ)
)

;;**********MVIEW UNLOCK LOCK IN ALL LAYOUTS*******************
(defun c:VPAU (/ THISTAB VPLIST)
  (setq THISTAB (getvar "CTAB"))
  (foreach LAYOUT (layoutlist)
    (setvar "CTAB" LAYOUT)
    (setq VPLST (ssget "x" (list (cons 0 "viewport"))))
    (setq c -1)
    (if VPLST
    (repeat (sslength VPLST)
      (setq VPS (cdr (car (entget (ssname VPLST (setq c (1+ c)))))))
      (setq vlaobj (vlax-ename->vla-object VPS))
      (vlax-put-property vlaobj 'Color 256)
    )
    (command "mview" "lock" "off" VPLST "")
  ))
  (setvar "CTAB" THISTAB)
  (princ)
)