RobertB
2004-06-09, 06:50 PM
The following code may serve as a boilerplate for those of you that wish to assign a LayerState to a layout, and have that LayerState activated automatically when the layout is made active.
' Written by R. Robert Bell
Private Function GetTabLState() As String
Dim Layout As AcadLayout
Set Layout = ThisDrawing.ActiveLayout
If Not (Layout.HasExtensionDictionary) Then SetTabLState
Dim XRec As AcadXRecord
Set XRec = Layout.GetExtensionDictionary("TabHasLState")
Dim dxfCodes, dxfData
XRec.GetXRecordData dxfCodes, dxfData
Dim Name As String
Dim i As Integer
For i = LBound(dxfCodes) To UBound(dxfCodes)
If dxfCodes(i) = 1 Then
Name = dxfData(i)
Exit For
End If
Next i
GetTabLState = Name
Set XRec = Nothing
Set Layout = Nothing
End Function
Public Sub SetTabLState()
Dim Name As String
Name = InputBox("Specify the LayerState to assign to the current layout.", "Assign LayerState")
Dim XRec As AcadXRecord
Set XRec = ThisDrawing.ActiveLayout.GetExtensionDictionary.AddXRecord("TabHasLState")
Dim dxfCodes(0) As Integer
Dim dxfData(0) As Variant
dxfCodes(0) = 1: dxfData(0) = Name
XRec.SetXRecordData dxfCodes, dxfData
Set XRec = Nothing
End Sub
Private Sub AcadDocument_LayoutSwitched(ByVal LayoutName As String)
RestoreLState GetTabLState()
End Sub
Private Sub RestoreLState(Name As String)
Dim LSMan As AcadLayerStateManager
Set LSMan = GetInterfaceObject("AutoCAD.AcadLayerStateManager.16")
LSMan.SetDatabase ThisDrawing.Database
If LStateExists(LSMan, Name) Then ThisDrawing.Regen (acAllViewports)
Set LSMan = Nothing
End Sub
Private Function LStateExists(LSMan As AcadLayerStateManager, Name As String) As Boolean
On Error Resume Next
LSMan.Restore Name
LStateExists = (Err.Number = 0)
If Not (LStateExists) Then MsgBox "The LayerState """ & Name & """ is assigned to the current layout, but cannot be found." & _
vbCrLf & "Please use the SetTabLState macro to reassign the LayerState, or recreate the Layer State.", vbInformation, "Missing assigned LayerState"
End Function
' Written by R. Robert Bell
Private Function GetTabLState() As String
Dim Layout As AcadLayout
Set Layout = ThisDrawing.ActiveLayout
If Not (Layout.HasExtensionDictionary) Then SetTabLState
Dim XRec As AcadXRecord
Set XRec = Layout.GetExtensionDictionary("TabHasLState")
Dim dxfCodes, dxfData
XRec.GetXRecordData dxfCodes, dxfData
Dim Name As String
Dim i As Integer
For i = LBound(dxfCodes) To UBound(dxfCodes)
If dxfCodes(i) = 1 Then
Name = dxfData(i)
Exit For
End If
Next i
GetTabLState = Name
Set XRec = Nothing
Set Layout = Nothing
End Function
Public Sub SetTabLState()
Dim Name As String
Name = InputBox("Specify the LayerState to assign to the current layout.", "Assign LayerState")
Dim XRec As AcadXRecord
Set XRec = ThisDrawing.ActiveLayout.GetExtensionDictionary.AddXRecord("TabHasLState")
Dim dxfCodes(0) As Integer
Dim dxfData(0) As Variant
dxfCodes(0) = 1: dxfData(0) = Name
XRec.SetXRecordData dxfCodes, dxfData
Set XRec = Nothing
End Sub
Private Sub AcadDocument_LayoutSwitched(ByVal LayoutName As String)
RestoreLState GetTabLState()
End Sub
Private Sub RestoreLState(Name As String)
Dim LSMan As AcadLayerStateManager
Set LSMan = GetInterfaceObject("AutoCAD.AcadLayerStateManager.16")
LSMan.SetDatabase ThisDrawing.Database
If LStateExists(LSMan, Name) Then ThisDrawing.Regen (acAllViewports)
Set LSMan = Nothing
End Sub
Private Function LStateExists(LSMan As AcadLayerStateManager, Name As String) As Boolean
On Error Resume Next
LSMan.Restore Name
LStateExists = (Err.Number = 0)
If Not (LStateExists) Then MsgBox "The LayerState """ & Name & """ is assigned to the current layout, but cannot be found." & _
vbCrLf & "Please use the SetTabLState macro to reassign the LayerState, or recreate the Layer State.", vbInformation, "Missing assigned LayerState"
End Function