[编程交流] 图纸集VBA索引

Dim ShtNum As String
Dim oSubset As AcSmSubset
Dim pSubset As AcSmSubset
Dim oSheet As AcSmSheet
Dim oItem As IAcSmPersist
Dim ShSetAR(1 To 3, 1 To 200) As String 
Dim ShSetARCount As Integer
'' Synchronize Sheets with Sheet Properties
Private Sub CopyShsetarray()
'' Create a Reference to the Sheet Set Manager Object
   Dim oSheetSetMgr As AcSmSheetSetMgr
   Set oSheetSetMgr = New AcSmSheetSetMgr
'' Get the current Sheet Set
   Dim oSheetDb As AcSmDatabase
   Set oSheetDb = oSheetSetMgr.GetDatabaseEnumerator().Next
'' Get the objects in the Sheet Set
   Dim oEnum As IAcSmEnumPersist
   Set oEnum = oSheetDb.GetEnumerator
'' Get the first object in the Enumerator
MsgBox oSheetDb.GetFileName
   Set oItem = oEnum.Next
'' Step through all the objects in the Sheet Set
MsgBox oItem.GetTypeName
       Do While Not oItem Is Nothing
'' Add Item to Array
On Error Resume Next
           If oItem.GetTypeName = "AcSmSheet" Or oItem.GetTypeName = "AcSmSubset" Then
               ShSetARCount = 1 + ShSetARCount
               Set pSubset = oItem.GetOwner()
               ShSetAR(2, (ShSetARCount)) = pSubset.GetName
               ShSetAR(3, (ShSetARCount)) = oItem.GetTypeName
                   If oItem.GetTypeName = "AcSmSheet" Then
                       Set oSheet = oItem
                       ShSetAR(1, (ShSetARCount)) = ShtNumFromPath(oSheet.GetLayout.GetFileName)
                       Else
                       Set oSubset = oItem
                       ShSetAR(1, (ShSetARCount)) = oSubset.GetName
                   End If
               'MsgBox ShSetARCount & "___" & ShSetAR(1, (ShSetARCount)) & "___" & ShSetAR(2, (ShSetARCount)) & "___" & ShSetAR(3, (ShSetARCount))
           End If
'' Get the next Sheet
       Set oItem = oEnum.Next
       Loop
       Next
End Sub

Dim ShSetAR(1 To 3, 1 To 200) As String 'number of used rows in (1,0)