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