27 | 06 | 2017

Turn Layer Off

Code:

Sub VpLayerOff(objPViewport As AcadPViewport, ByVal layer As String)

'****************************************
'*** Code from VisibleVisual.com ********
'****************************************

' make the layer non displayable (freeze) in the current Viewport
Dim objEntity As AcadObject
'Dim objPViewport As AcadObject
Dim objPViewport2 As AcadObject
Dim XdataType As Variant
Dim XdataValue As Variant
Dim I As Integer
Dim Counter As Integer
Dim PT1 As Variant

' Get the active ViewPort
'If nr = 1 Then
'Set objPViewport = newVport1
'ElseIf nr = 2 Then
'Set objPViewport = newVport2
'ElseIf nr = 3 Then
'Set objPViewport = newVport3
'ElseIf nr = 4 Then
'Set objPViewport = newVport4
'End If

' 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) = layer Then MsgBox "XX" '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 beeing frozen
XdataType(Counter) = 1003
XdataValue(Counter) = layer

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.
' Update the viewport...

ThisDrawing.Utility.Prompt ("Done!" & vbCr)
End Sub
Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2288475
Latest Articles