Thaw a Layer in a specific Viewport. (Autocad 2016)

- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi found this VBA to freeze a layer in a viewport (Call VPLayerOff("XXXXX"). Is it possible to use the same configuration of VBA, to Thaw a layer in a viewport like (Call VPLayerOn("YYYYYY")?
what should be the changes?
**********************************************************************
' Make the layers non displayable (Freeze) in the current Viewport
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
If LayerExist(strLayer) = True Then
' 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
End If
End Sub
**********************************************************************
Thank's!