Message 1 of 1
Layer Freeze/Thaw in PViewPort

Not applicable
01-15-2007
10:01 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Many thanks to Joe for his response last week.
I was able to create a function that froze a layer in a given paperspace view port.
So far so good.
I am trying to thaw a layer in a view port and for some reason my SetXdata is not taking.
The following funciton does not crash or create any errors, but it also does not change
the Xdata for the view port:
[code]
Public Sub VPLayerOn(l_Layer As String, Vport As AcadPViewport)
' l_Layer is the layer to turn on (i.e. remove from the pvport Xdata
' VPort is the Paperspace view port
' this routine assumes
' 1. that the frozen layers are in the first nested 1002 group
' 2. that the xdata array ends with two closing 1002 group } codes
' 3. That the 3rd to the last xdata entity is the last frozen layer name
Dim XDataType As Variant
Dim XDataVal As Variant
Dim NewXDataType As Variant
Dim NewXDataVal As Variant
Dim Index As Long
Dim Found As Boolean
Dim MaxXData As Long
Found = False
Vport.GetXData "ACAD", XDataType, XDataVal ' Get the XData for the view port
MaxXData = UBound(XDataType)
ReDim NewXDataType(MaxXData - 1) As Integer
ReDim NewXDataVal(MaxXData - 1)
For Index = 0 To MaxXData - 1
If Not Found Then '
NewXDataType(Index) = XDataType(Index) ' copy data to new array
NewXDataVal(Index) = XDataVal(Index)
If XDataType(Index) = 1003 Then ' this is a layer type
If XDataVal(Index) = l_Layer Then
Found = True ' this is the layer to remove
NewXDataType(Index) = XDataType(Index + 1) ' copy data to new array
NewXDataVal(Index) = XDataVal(Index + 1) ' so that we overwrite layer to remove
End If
End If
Else
NewXDataType(Index) = XDataType(Index + 1) ' copy the next down 1 place
NewXDataVal(Index) = XDataVal(Index + 1) ' for all the rest of the entires
End If
Next Index
If Found Then ' we want to redefine the viewport Xdata
Vport.SetXData NewXDataType, NewXDataVal ' reset XData to view port
Vport.update
End If
End Sub
[\code]
Phil Custer, P.E.
Custer Services, Inc.
custer@landfillgas.com
I was able to create a function that froze a layer in a given paperspace view port.
So far so good.
I am trying to thaw a layer in a view port and for some reason my SetXdata is not taking.
The following funciton does not crash or create any errors, but it also does not change
the Xdata for the view port:
[code]
Public Sub VPLayerOn(l_Layer As String, Vport As AcadPViewport)
' l_Layer is the layer to turn on (i.e. remove from the pvport Xdata
' VPort is the Paperspace view port
' this routine assumes
' 1. that the frozen layers are in the first nested 1002 group
' 2. that the xdata array ends with two closing 1002 group } codes
' 3. That the 3rd to the last xdata entity is the last frozen layer name
Dim XDataType As Variant
Dim XDataVal As Variant
Dim NewXDataType As Variant
Dim NewXDataVal As Variant
Dim Index As Long
Dim Found As Boolean
Dim MaxXData As Long
Found = False
Vport.GetXData "ACAD", XDataType, XDataVal ' Get the XData for the view port
MaxXData = UBound(XDataType)
ReDim NewXDataType(MaxXData - 1) As Integer
ReDim NewXDataVal(MaxXData - 1)
For Index = 0 To MaxXData - 1
If Not Found Then '
NewXDataType(Index) = XDataType(Index) ' copy data to new array
NewXDataVal(Index) = XDataVal(Index)
If XDataType(Index) = 1003 Then ' this is a layer type
If XDataVal(Index) = l_Layer Then
Found = True ' this is the layer to remove
NewXDataType(Index) = XDataType(Index + 1) ' copy data to new array
NewXDataVal(Index) = XDataVal(Index + 1) ' so that we overwrite layer to remove
End If
End If
Else
NewXDataType(Index) = XDataType(Index + 1) ' copy the next down 1 place
NewXDataVal(Index) = XDataVal(Index + 1) ' for all the rest of the entires
End If
Next Index
If Found Then ' we want to redefine the viewport Xdata
Vport.SetXData NewXDataType, NewXDataVal ' reset XData to view port
Vport.update
End If
End Sub
[\code]
Phil Custer, P.E.
Custer Services, Inc.
custer@landfillgas.com