Norman,
It worked perfectly, thanks you. See below for the outcome:
''' <summary>
''' Gets the sheet reference of a given DWGs layout
''' </summary>
''' <param name="DWGsDB">The database of the DWG</param>
''' <param name="DWGsLayoutId">The ObjectID of the layout</param>
''' <returns>The AcSmSheet of the sheet reference, or Nothing if not found</returns>
''' <remarks></remarks>
Public Shared Function GetLayoutsSheet(ByVal DWGsDB As Database, ByVal DWGsLayoutId As ObjectId) As AcSmSheet
'Dim DWGsDB As Database = LayoutIn.Database
Dim SSM As IAcSmSheetSetMgr = New AcSmSheetSetMgr
Dim SSsDB As AcSmDatabase = Nothing
Dim SheetOut As AcSmSheet = Nothing
'Obtain the sheetset DST from the DWGs dictionary entry
Dim SSsDSTfileName As String = SheetSets.InterrogateDWG(DWGsDB, desiredIntel.ShSetFileName)
If SSsDSTfileName IsNot Nothing Then
'See if the sheetset is open, if not open it
If SSM.FindOpenDatabase(SSsDSTfileName) Is Nothing Then
Try
SSsDB = SSM.OpenDatabase(SSsDSTfileName, False)
Catch ex As Exception
End Try
Else
SSsDB = SSM.FindOpenDatabase(SSsDSTfileName)
End If
Else
'No sheetset for us to gather a sheets from, abort now
Return Nothing
End If
Dim DWGsLayoutName As String = Nothing
Dim DWGsLayoutFileName As String = Nothing
Dim SSsLayoutRef As AcSmAcDbLayoutReference = Nothing
Using Trans As Transaction = DWGsDB.TransactionManager.StartTransaction
Dim myLayout As Layout = DWGsLayoutId.GetObject(OpenMode.ForRead)
DWGsLayoutName = myLayout.LayoutName
DWGsLayoutFileName = myLayout.Database.Filename
End Using
'If the DWG's SS is available, dig deeper
If SSsDB IsNot Nothing Then
Dim enumerator As IAcSmEnumPersist = SSsDB.GetEnumerator()
Dim thisItem As IAcSmPersist = enumerator.Next() 'Get first
Do While thisItem IsNot Nothing
Dim thisSheet As AcSmSheet = Nothing
'Check to see if the object is a sheet
If thisItem.GetTypeName() = "AcSmSheet" Then
thisSheet = thisItem
SSsLayoutRef = thisSheet.GetLayout
Dim SSsLayoutRefsName As String = SSsLayoutRef.GetName()
Dim SSsLayoutRefsFileName As String = SSsLayoutRef.GetFileName()
If DWGsLayoutName = SSsLayoutRefsName And _
DWGsLayoutFileName = SSsLayoutRefsFileName Then
SheetOut = thisSheet
Exit Do
End If
End If
'Get the next item
thisItem = enumerator.Next
Loop
Else
'SheetSet could not be accessed, abort
Return Nothing
End If
Return SheetOut
End Function
Enum desiredIntel
LayoutHandle
LayoutName
SheetDwgName
ShSetFileName
ShSetVersion
UpdateCount
UpdateTime
End Enum
''' <summary>
''' Gets SheetSet info stored in the dictionary of a given drawing database
''' </summary>
''' <param name="DbIn">Drawing database to interrogate</param>
''' <param name="desiredIntel">Property to retreive</param>
''' <returns>String value of the dictionary entry</returns>
''' <remarks></remarks>
Public Shared Function InterrogateDWG(ByVal DbIn As Database, ByVal desiredIntel As desiredIntel) As String
Dim thisDb As Database = HostApplicationServices.WorkingDatabase
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
'See if this DWG has a sheetset associated & open
Dim IntelOut As String = Nothing
If IntelOut = Nothing Then
'If not see if this DWG has a sheetset associated & closed
'Obtain DST file name from the DWG file's dictionary
Using myTrans As Transaction = thisDb.TransactionManager.StartTransaction
Dim nod As DBDictionary = myTrans.GetObject(thisDb.NamedObjectsDictionaryId, OpenMode.ForRead)
If nod.Contains("AcSheetSetData") Then
Dim knd As DBDictionary = myTrans.GetObject(nod.GetAt("AcSheetSetData"), OpenMode.ForRead)
'Dim dbEnum As DbDictionaryEnumerator = knd.GetEnumerator
'Dim thisEntry As DBDictionaryEntry = dbEnum.Current
'While IsNothing(thisEntry) = False
' ed.WriteMessage(thisEntry.Key)
'End While
If knd.Contains(desiredIntel.ToString) Then
Dim ksoEntry As ObjectId = knd.GetAt(desiredIntel.ToString)
Dim ksoXrecord As Xrecord = myTrans.GetObject(ksoEntry, OpenMode.ForRead)
For Each value As TypedValue In ksoXrecord.Data
If value.TypeCode = 1 Then
IntelOut = value.Value.ToString()
Exit For
End If
Next
End If
End If
End Using
End If
Return IntelOut
End Function
Thank you,
Jeff
Detroit, MI
