Viewport Lock

[Norts]

Is there a means of programming something so that some text appears on screen near to any viewport that is NOT locked?

I would like the barebones of some code if possible, so that I could edit the size and contents of the text myself.

Also, if possible, some other means of 'highlighting' the viewport(s) in question would be great too.

Thanks in advance.

[Norts]

Dang, where's Asmi when you need him

[ASMI]

Something like this?


Sub MarkUpUnlockedViewports()
Dim psSp As AcadPaperSpace
Dim curVp As AcadEntity
Dim txtObj As AcadText
Dim shFlag As Boolean

Set psSp = ThisDrawing.PaperSpace

For Each curVp In psSp
If curVp.ObjectName = "AcDbViewport" Then
If curVp.DisplayLocked = False And shFlag = True Then
Set txtObj = psSp.AddText("Lock Me!!!", curVp.Center, 15#)
txtObj.color = acRed
curVp.color = acRed
End If
shFlag = True
End If
Next curVp

End Sub

It without any checkups...

[ASMI]

Lisp variant - with some errors prevention (unlock and ufreeze layers and restore after) but without text drawing (it's easy to add) but with unlocked viewports counter.


(defun c:unv(/ psCol lCount laySt)

(vl-load-com)

(defun asmi-LayersUnlock(/ restLst)
(setq restLst '())
(vlax-for lay
(vla-get-Layers
(vla-get-ActiveDocument
(vlax-get-acad-object)))
(setq restLst
(append restLst
(list
(list
lay
(vla-get-Lock lay)
(vla-get-Freeze lay)
); end list
); end list
); end append
); end setq
(vla-put-Lock lay :vlax-false)
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list lay :vlax-false)))
t)
); end vlax-for
restLst
); end of asmi-LayersUnlock

(defun asmi-LayersStateRestore(StateList)
(foreach lay StateList
(vla-put-Lock(car lay)(cadr lay))
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'vla-put-Freeze(list(car lay)(nth 2 lay))))
t)
); end foreach
(princ)
); end of asmi-LayersStateRestore

(setq psCol
(vla-get-PaperSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)))
lCount -1
laySt(asmi-LayersUnlock)
); end setq
(vlax-for itm psCol
(if
(= "AcDbViewport"(vla-get-ObjectName itm))
(if
(= :vlax-false(vla-get-DisplayLocked itm))
(progn
(vla-put-ViewportOn itm :vlax-true)
(vla-put-Color itm 1)
(setq lCount(1+ lCount))
); end progn
(vla-put-Color itm 256)
); end if
); end if
); end vlax-for
(asmi-LayersStateRestore laySt)
(if(/= 0 lCount)
(princ
(strcat "\n<<< Found "(itoa lCount)
" unlocked Viewport(s)! >>> "))
(princ
(strcat "\nNothing unlocked viewport(s) found... "))
); end if
(princ)
); end of c:unv

[Norts]

Thanks Asmi, you're a genius.
the lisp one works a treat, now all i need to do stick some text on the same layer that the viewport was created on.

the vba one does everything i requested, spot on sir

[ASMI]

Ok.


Sub MarkUpUnlockedViewports()
Dim psSp As AcadPaperSpace
Dim curVp As AcadEntity
Dim txtObj As AcadText
Dim shFlag As Boolean

Set psSp = ThisDrawing.PaperSpace

For Each curVp In psSp
If curVp.ObjectName = "AcDbViewport" Then
If curVp.DisplayLocked = False And shFlag = True Then
Set txtObj = psSp.AddText("Lock Me!!!", curVp.Center, 15#)
txtObj.color = acRed
txtObj.Layer = curVp.Layer
curVp.color = acRed
End If
shFlag = True
End If
Next curVp

End Sub

[Norts]

Excellent stuff, and many many thanks :)

[CAB]

I use color to indicate Lock/Unlock
http://www.theswamp.org/index.php?topic=7097.0


;;; ++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++
;;; + Viewport Lock/Unlock +
;;; + Created by C. Alan Butler +
;;; + Copyright 2005-2006 +
;;; + by Precision Drafting & Design All Rights Reserved. +
;;; + Contact at ab2draft@TampaBay.rr.com +
;;; + look for updates in TheSwamp.org +
;;; ++++++++++++++++++++++++++++++++++++++++++++++++++ ++++++++
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; You are hereby granted permission to use, copy and modify this
;;; software without charge, provided you do so exclusively for
;;; your own use or for use by others in your organization in the
;;; performance of their normal duties, and provided further that
;;; the above copyright notice appears in all copies and both that
;;; copyright notice and the limited warranty and restricted rights
;;; notice below appear in all supporting documentation.
;;;
;;; Version 05.12.07

;;; The following are several routines for locking & unlocking viewports
;;; They are dependent on subroutines vplock & vp_sel
;;;
;;; c:vpunlockall unlock all vp & set color to green
;;; c:vplockall lock all vp and set color to red
;;; c:vplock lock one vp & set color to red
;;; c:vpunlock unlock one vp & set color to green
;;; c:vptogle toggle vp lock & color until ENTER
;;; c:vpl choice to user to lock or unlock, one or all
;;; c:vplockctab lock all vp in ctab, set color to red
;;; c:vpunlockctab UNlock all vp in ctab, set color to green
;;;
;;; vplock sub lock or unlock one or all vp and set color
;;; vp_sel sub user pick vp - return the ename of vp or nil


;;; Viewport Colors
;;; Viewports will have there color changed to the following:
;;; use any valid color number or
;;; acRed, acYellow, acGreen, acCyan, acBlue, acMagenta, acWhite
(setq *vpColorLk acRed ; Lock Color
*vpColorUnLk acGreen ; UnLock Color
)
;;; Prevent color change by using -1
;;; (setq *vpColorLk -1 *vpColorUnLk -1)
;;; To return to Color ByLayer use 256