; =============================================================================
; Filename : LockVp.lsp
; Datum : 16.06.04
; Author : jme
; Copyright : MENZI ENGINEERING GmbH, Switzerland
; Revision 1 : 17.06.04 jme - Modified to proceed all Viewports
; Revision 2 : 23.12.05 jme - English version
; Revision 3 : __.__.__ ___ -
; -----------------------------------------------------------------------------
; Description:
; Lock or unlock the selected Viewport.
; -----------------------------------------------------------------------------
; Global variables:
;
; -----------------------------------------------------------------------------
; Internal LISP-functions:
;
; -----------------------------------------------------------------------------
; External LISP-functions:
;
; -----------------------------------------------------------------------------
; Version notes:
; AutoCAD: Version: Language: AddIns:
; 15+ 1.02 English ...
; -----------------------------------------------------------------------------
;
; == Message on loading =======================================================
;
(princ "\nLockVp v1.02")
;
; == Main program =============================================================
;
(defun C:LVP ( / SelSet TmpObj VptEnt VptObj)
(cond
(( (getvar "CVPORT") 1))
(alert " LockVp can only be done in paper space. ")
)
((and
(not (prompt "\nSelect Viewport for Lock or UnLock... "))
(not (setq SelSet (ssget "_:E:S" '((0 . "VIEWPORT")))))
)
(princ "Nothing or no Viewport selected.")
)
(T
(vl-load-com)
(setq VptEnt (ssname SelSet 0)
VptObj (vlax-ename->vla-object VptEnt)
)
(if (eq (vla-get-DisplayLocked VptObj) :vlax-false)
(progn
(vla-put-DisplayLocked VptObj :vlax-true)
(if (setq TmpObj (cdr (assoc 340 (entget VptEnt))))
(vla-put-Color (vlax-ename->vla-object TmpObj) acBlue)
(vla-put-Color VptObj acBlue)
)
(princ "\nViewport locked.")
)
(progn
(vla-put-DisplayLocked VptObj :vlax-false)
(if (setq TmpObj (cdr (assoc 340 (entget VptEnt))))
(vla-put-Color (vlax-ename->vla-object TmpObj) acByLayer)
(vla-put-Color VptObj acByLayer)
)
(princ "\nViewport unlocked.")
)
)
)
)
(princ)
)
;
; == Copyright - Note (May be never deleted) ==================================
;
(princ "\n------------------------------------------------")
(princ "\n ©2004-2005 MENZI ENGINEERING GmbH, Switzerland ")
(princ "\n------------------------------------------------")
(princ "\nType LockVp in the command line to start the programm...")
(princ)
;
; == End LockVp ===============================================================
(c:lvp)

Advertisements