Ok here it is:
Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database
Dim Trans As Transaction = db.TransactionManager.StartTransaction
Dim LayMan As LayerStateManager = db.LayerStateManager
Try
Using Application.DocumentManager.MdiActiveDocument.LockDocument
Dim LayerT As LayerTable = Trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim SelOps As Autodesk.AutoCAD.EditorInput.PromptSelectionOptions = New PromptSelectionOptions
Dim statename As String = ""
Dim ObjectID As Autodesk.AutoCAD.DatabaseServices.ObjectId
Dim LayersOn As ArrayList = New ArrayList
SelOps.MessageForAdding = "Select a VP"
For x As Integer = 0 To IGrid2.Rows.Count - 1
If IGrid2.Cells.Item(x, 0).Selected = True Then
statename = IGrid2.Cells.Item(x, 0).Value
Exit For
End If
Next
If LayMan.HasLayerState(statename) Then
Dim LayerID As ObjectId = LayerT.Item("0")
db.Clayer = LayerID
LayMan.RestoreLayerState(statename, ObjectID, 2, 1023)
End If
Dim FLayerCol As New Collection
Dim FLayerList As ArrayList = New ArrayList
For Each Lid As ObjectId In LayerT
Dim LayerX As LayerTableRecord = Trans.GetObject(Lid, OpenMode.ForRead)
If LayerX.IsFrozen = True Then
FLayerCol.Add(LayerX.Id)
Else
FLayerList.Add(LayerX.Name)
End If
Next
Dim EntOps As PromptEntityOptions = New PromptEntityOptions("Select Viewport: ")
EntOps.AllowObjectOnLockedLayer = True
EntOps.AllowNone = False
Dim EntRes As PromptEntityResult = ed.GetEntity(EntOps)
Dim SelVP As Viewport = Nothing
If EntRes.Status = PromptStatus.OK Then
SelVP = Trans.GetObject(EntRes.ObjectId, OpenMode.ForWrite, False, True)
Else
Exit Sub
End If
'try saving an xrecord to save which layers must be on for this layout.
Try
Dim LayoutMan As LayoutManager = LayoutManager.Current
Dim dict As DBDictionary = CType(Trans.GetObject(db.NamedObjectsDictionaryId, OpenMode.ForWrite, False), DBDictionary)
Dim rec As New Xrecord()
Dim Vals(FLayerList.Count - 1) As TypedValue
Dim TDict As DBDictionary
Try
TDict = Trans.GetObject(dict.GetAt(LayoutMan.CurrentLayout), OpenMode.ForWrite, False, True)
Catch ex As Exception
TDict = New DBDictionary
dict.UpgradeOpen()
dict.SetAt(LayoutMan.CurrentLayout, TDict)
Trans.AddNewlyCreatedDBObject(TDict, True)
End Try
Dim rb As TypedValue
Dim Entity As Autodesk.AutoCAD.DatabaseServices.Entity = Trans.GetObject(EntRes.ObjectId, OpenMode.ForWrite)
If TypeOf Entity Is Autodesk.AutoCAD.DatabaseServices.Viewport Then
Dim ThisVP As Viewport = Trans.GetObject(Entity.Id, OpenMode.ForWrite)
'Vals(0) = New TypedValue(DxfCode.Text, ThisVP.ObjectId.ToString)
FLayerList.Sort()
For x As Integer = 0 To FLayerList.Count - 1
Vals(x) = New TypedValue(DxfCode.LayerName, FLayerList.Item(x))
Next
rec.Data = New ResultBuffer(Vals)
TDict.SetAt(ThisVP.ObjectId.ToString, rec)
ThisVP.ThawAllLayersInViewport()
ThisVP.FreezeLayersInViewport(FLayerCol.GetEnumerator)
'Exit For
End If
'Next
Dim FinaL As ArrayList = New ArrayList
Dim C As Integer = 1
Try
For Each dbEnt As DBDictionaryEntry In TDict
'ed.WriteMessage(ControlChars.Lf & "XRecord: " & dbEnt.Key & " found with the following values:" & ControlChars.Lf)
'Dim tempD As DBDictionary = Trans.GetObject(dbEnt.Value, OpenMode.ForRead)
Dim TXrec As Xrecord = CType(Trans.GetObject(TDict.GetAt(dbEnt.Key), OpenMode.ForRead), Xrecord)
If C = 1 Then
For Each rb In TXrec.Data.AsArray
FinaL.Add(rb.Value)
Next rb
C += 1
Else
For Each rb In TXrec.Data.AsArray
If FinaL.Contains(rb.Value) = False Then
FinaL.Add(rb.Value)
End If
Next
End If
'For Each rb In TXrec.Data.AsArray
'ed.WriteMessage(String.Format("TypeCode={0}, Value={1}" + ControlChars.Lf, rb.TypeCode, rb.Value))
'Next rb
Next
FinaL.Sort()
For x As Integer = 0 To FinaL.Count - 1
Vals(x) = New TypedValue(DxfCode.LayerName, FinaL.Item(x))
ed.WriteMessage(ControlChars.Lf & FinaL.Item(x))
Next
rec.Data = New ResultBuffer(Vals)
TDict.SetAt("MasterList", rec)
Catch ex As Exception
End Try
Catch ex As Exception
MsgBox("The following error occurred: " & vbCrLf & ex.Message & vbCrLf & ex.StackTrace)
End Try
End Using
Trans.Commit()
Application.DocumentManager.MdiActiveDocument.LockDocument.Dispose()
TurnOnLayers(True)
ForceRegen()
'Trans.Commit()
Catch ex As Exception
Trans.Abort()
MsgBox("The following error occurred: " & vbCrLf & ex.Message & vbCrLf & ex.StackTrace)
Finally
Trans.Dispose()
Me.Close()
Application.DocumentManager.MdiActiveDocument.LockDocument.Dispose()
End Try
