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

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

Anonymous
Not applicable
1,174 Views
0 Replies
Message 1 of 1

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

Anonymous
Not applicable

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!

0 Likes
1,175 Views
0 Replies
Replies (0)