Assign a LayerState to a Layout

[RobertB]

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