Select Objects in PVP to VPFreeze - Inverting Selection To Freeze

I found some great code here on the NG that allows a user to pick objects in a paperspace VP and freeze them in that viewport.
I'd like to add one feature to this - instead of freezing the objects selected, how about freezing everything except what's picked.

I'm sorry to bother you with such a seemingly simple task, but setting the viewport visibility really should be a property of the vp, not xdata, shouldn't it (at least SOMEthing a bit easier to get at)

I think this is the code that needs to be updated:

Code:

For Each objEntity In newSS
strLayer = objEntity.Layer
VPLayerOff (strLayer)
Next

Its as if i need to collections (not the object) - one of all layer names, the second of layers selected. Then I'd need to remove the layers from the first that appear in the second.

I'm looking for an elegant way to do this, not my usual "brute force" approach...

Here's the entire routine:

Code:

'LAST REVISED: 10/19/04
Option Explicit

'Select objects to freeze within VP

Public Sub Select_Objects_To_Freeze_In_ViewPort()

Dim objEntity As AcadObject
Dim strLayer As String
Dim Pt1 As Variant
Dim newSS As AcadSelectionSet
Dim vLayers() As Variant

On Error GoTo err_selectVPobjectsToFreeze


If ThisDrawing.ActiveSpace = acModelSpace Then
MsgBox "This program only works with PaperSpace Viewports" & vbCr & _
"Please go to PaperSpace", vbCritical
Exit Sub
End If

ThisDrawing.StartUndoMark

ThisDrawing.MSpace = True
Set newSS = ThisDrawing.SelectionSets.Add("Vplayers_")
ThisDrawing.Utility.Prompt ("Select Objects layers to freeze in the viewport:" & vbCr)
newSS.SelectOnScreen
For Each objEntity In newSS
strLayer = objEntity.Layer
VPLayerOff (strLayer)
Next

ViewPortUpdate
newSS.Delete
ThisDrawing.EndUndoMark

Exit Sub

err_selectVPobjectsToFreeze:
MsgBox Err.Description, vbInformation
Err.Clear
ThisDrawing.EndUndoMark
End Sub



' make the layer non displayable (freeze) in the current Viewport


Private Sub VPLayerOff(strLayer As String)
Dim objPViewport As AcadObject
Dim XdataType As Variant
Dim XdataValue As Variant
Dim i As Integer
Dim Counter As Integer

' Get the active ViewPort
Set objPViewport = ThisDrawing.ActivePViewport

' Get the Xdata from the Viewport
objPViewport.GetXData "ACAD", XdataType, XdataValue

For i = LBound(XdataType) To UBound(XdataType)
' Look for frozen Layers in this viewport
If XdataType(i) = 1003 Then
' Set the counter AFTER the position of the Layer frozen layer(s)
Counter = i + 1
' If the layer is already in the frozen layers xdata of this viewport the
' exit this sub program
If XdataValue(i) = strLayer Then Exit Sub
End If
Next

' If no frozen layers exist in this viewport then
' find the Xdata location 1002 and place the frozen layer infront of the "}"
' found at Xdata location 1002
If Counter = 0 Then
For i = LBound(XdataType) To UBound(XdataType)
If XdataType(i) = 1002 Then Counter = i - 1
Next
End If

' set the Xdata for the layer that is being frozen
XdataType(Counter) = 1003
XdataValue(Counter) = strLayer

ReDim Preserve XdataType(Counter + 1)
ReDim Preserve XdataValue(Counter + 1)

' put the first "}" back into the xdata array
XdataType(Counter + 1) = 1002
XdataValue(Counter + 1) = "}"

' Keep the xdata Array and add one more to the array
ReDim Preserve XdataType(Counter + 2)
ReDim Preserve XdataValue(Counter + 2)

' put the second "}" back into the xdata array
XdataType(Counter + 2) = 1002
XdataValue(Counter + 2) = "}"

' Reset the Xdata on to the viewport
objPViewport.SetXData XdataType, XdataValue

' notice that at this point NOTHING happens in the viewport to visibly show
' any changes to the viewport.
' flipping to a different layout or turning the Mview Off and On will display the
' Xdata changes to the viewport.
' See sub ViewPortUpdate for how to update the Viewport.

End Sub


Private Sub ViewPortUpdate()
' Update the viewport...
Dim objPViewport As AcadObject

Set objPViewport = ThisDrawing.ActivePViewport
ThisDrawing.MSpace = False
objPViewport.Display (False)
objPViewport.Display (True)
ThisDrawing.MSpace = True
ThisDrawing.Utility.Prompt ("Done!" & vbCr)
End Sub

 

Select everything with one selectionset. Then prompt the use to select
object with another selectionset. Iterate the second, stuffing the
selected entities into an array then use that array as the argument for
the first set's RemoveItems method.

BTW, that code canbe tightened up by iterating the set, collecting the
layer names into a collection or array and processing all the layers at
once rather than individually.

 

You're not really trying to invert the selection set, correct? You're
trying to freeze all layers except the ones of the selected objects, right?

Brute force is the quickest (to get coded, I mean) way I know of, something
like:

dim curLayer as acadlayer
for each curlayer in curDoc.layers
strLayer = curLayer.name
if not LayerInSelSet(strLayer, "selSetName") then
VPLayerOff (strLayer)
endif
next 'curLayer

function LayerInSelSet(layerName as string, setName as string) as boolean
set curSet = thisdrawing.selectionsets(setName)
for each curEntity in curSet
if layerName = curEntity.Layer.Name then
LayerInSelSet = True
exit for
endif
next 'curEntity
end function

HTH,
James

in a paperspace VP and freeze them in that viewport.

selected, how about freezing everything except what's picked.

viewport visibility really should be a property of the vp, not xdata,
shouldn't it (at least SOMEthing a bit easier to get at)

the second of layers selected. Then I'd need to remove the layers from the
first that appear in the second.