Sheet Set Manager code snippets

Some sample AutoCAD Sheet Set Manager (SSM) code for VBA that might help along the way. I don't remember if they worked or not. modEmptySheetValues

' This will set all empty values to chr(160) in the active sheet set.

Sub EmptyAllSheetValuesToEmpty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Debug.Print db.GetFileName
       
    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        On Error Resume Next
        Debug.Print comp.GetName & "," & comp.GetDesc
        On Error GoTo 0
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            Dim propIter As IAcSmEnumProperty
            Set propIter = comp.GetCustomPropertyBag.GetPropertyEnumerator
        
            Dim propname As String
            Dim propval As AcSmCustomPropertyValue
            Do While True
                Set propval = Nothing
                propname = ""
                propIter.Next propname, propval
                If propname = "" Then Exit Do
        
                If Not IsEmpty(propval) And Not IsObject(propval) Then
                    If propval.GetFlags = CUSTOM_SHEET_PROP Then
                        If IsEmpty(propval.GetValue) Then
                        
                            Dim oProjNum As New AcSmCustomPropertyValue
                            PropFlag = CUSTOM_SHEET_PROP

                            oProjNum.InitNew comp
                            oProjNum.SetFlags PropFlag
                            oProjNum.SetValue Chr(160)
                            comp.GetCustomPropertyBag.SetProperty propname, oProjNum
                            Set oProjNum = Nothing
                        End If
                    End If
                End If
            Loop
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modCustSheetSetProperties

' This works on Sheet Set level. Not on Sheet level
' It iterates through the Custom Properties
Private Sub GetCustSheetProp()
    Dim oSSM As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim oSheetSetDb As AcSmDatabase
    Dim oSheetSet As AcSmSheetSet
    
    On Error GoTo ErrHandler
    
    If oSSM Is Nothing Then
      Return
    End If
    Set dbIter = oSSM.GetDatabaseEnumerator
    If dbIter Is Nothing Then
      Return
    End If
    dbIter.Reset
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        Return
    End If
    'get the sheetset
    Set oSheetSet = db.GetSheetSet
    If oSheetSet Is Nothing Then
     Return
    End If
    Set oSheetIter = oSheetSet.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    'lock db
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    End If

    Debug.Print oSheetSet.GetName
    Debug.Print oSheetSet.GetDesc
    
    Dim propIter As IAcSmEnumProperty
    Set propIter = oSheetSet.GetCustomPropertyBag.GetPropertyEnumerator

    Dim propname As String
    Dim propval As AcSmCustomPropertyValue
    Do While True
        Set propval = Nothing
        propname = ""
        propIter.Next propname, propval
        Set propval = Nothing
        Set propval = oSheetSet.GetCustomPropertyBag.GetProperty(propname)
        Debug.Print "Sheet Set Property: " & propname & " : " & propval.GetValue
        If propname = "" Then Exit Do
        If Not IsEmpty(propval) And Not IsObject(propval) Then
            If propval.GetFlags = CUSTOM_SHEET_PROP Then
                Debug.Print "Sheet Property: " & propname & " : " & propval.GetValue
                ' remove 01-Document Number
                If propval.GetValue = "01-Document Number" Then
                    Dim oProp2 As New AcSmCustomPropertyValue
                    Set oProp2 = Nothing
                    PropFlag = CUSTOM_SHEET_PROP
                    oProp2.InitNew comp
                    oProp2.SetFlags PropFlag
                    oProp2.SetValue Null
                    ' Remove this property by setting it to Null
                    comp.GetCustomPropertyBag.SetProperty "01-Document Number", oProp2
                    Set oProp2 = Nothing
                End If
            End If
        End If
    Loop

    GoSub Cleanup

    Exit Sub

Cleanup:
    db.UnlockDb db
    
    Set oSheetSet = Nothing
    Set oSheetSetDb = Nothing
    Return
    
ErrHandler:
    GoSub Cleanup
End Sub

modAddSheetSetProperty

' Add a new Sheet Set property to all sheets in the current Sheet Set

Sub AddSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Debug.Print db.GetFileName
       
    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        On Error Resume Next
        Debug.Print comp.GetName & "," & comp.GetDesc
        On Error GoTo 0
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
        
            Dim oProp As New AcSmCustomPropertyValue
            PropFlag = CUSTOM_SHEET_PROP

            oProp.InitNew comp
            oProp.SetFlags PropFlag
            oProp.SetValue Chr(160)
            comp.GetCustomPropertyBag.SetProperty "04-Doc Description", oProp
            Set oProp = Nothing
           
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modRenameSSProperty

' Rename Sheet Set property to all sheets in the current Sheet Set
Sub unlockss()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Set dbIter = ssm.GetDatabaseEnumerator
    Set db = dbIter.Next
    Call db.UnlockDb(db, True)
End Sub

Sub RenameSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Debug.Print db.GetFileName
       
    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        On Error Resume Next
        Debug.Print comp.GetName & "," & comp.GetDesc
        On Error GoTo 0
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then

            Dim propval As AcSmCustomPropertyValue
        
            Set propval = Nothing
            Set propval = comp.GetCustomPropertyBag.GetProperty("04-Document Subtitle")
            sOld = propval.GetValue
            Set propval = Nothing
        
            Dim oProp As New AcSmCustomPropertyValue
            PropFlag = CUSTOM_SHEET_PROP

            oProp.InitNew comp
            oProp.SetFlags PropFlag
            oProp.SetValue sOld
            
            comp.GetCustomPropertyBag.SetProperty "04-Doc Subtitle", oProp
            Set oProp = Nothing
              
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modSetCustSheetSetProperty

Dim propvalue As String
Dim propname As String

Sub unlockdbnow()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    Set dbIter = ssm.GetDatabaseEnumerator
    Set db = dbIter.Next
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Sub CheckAndCorrectSSProperties()
propvalue = "0"
propname = "10-Last Revision GNETA"
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Debug.Print db.GetFileName

    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            
            Dim propval1 As AcSmCustomPropertyValue
            Dim prop1 As String
        
            Set propval1 = Nothing
            Set propval1 = s.GetCustomPropertyBag.GetProperty(propname)
            If propval1 Is Nothing Then
                ' The property doesn't exist
                Exit Sub
            End If
            Set propval1 = Nothing
            
            Dim propval As New AcSmCustomPropertyValue
            
            Dim bag As IAcSmCustomPropertyBag
            Set bag = s.GetCustomPropertyBag
            PropFlag = CUSTOM_SHEET_PROP
            propval.InitNew bag
            propval.SetFlags PropFlag
            propval.SetValue propvalue
            bag.SetProperty propname, propval
            Set propval = Nothing

        ' if the component is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub                                                       

modCheckAndCorrectSSProperties

' This will check the active sheet set.
' "Sheet number" is overriding the "01-Document Number"
' "Sheet title" is overriding the "03-Document Title"

Sub CheckAndCorrectSSProperties()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If
    Debug.Print db.GetFileName

    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            Dim sNumber As String
            Dim sTitle As String
            sNumber = s.GetNumber
            sTitle = s.GetTitle
            If sNumber = "" Then sNumber = Chr(160)
            If sTitle = "" Then sTitle = Chr(160)
            
            Dim propval As New AcSmCustomPropertyValue
            Dim bag As IAcSmCustomPropertyBag
            Set bag = s.GetCustomPropertyBag
            PropFlag = CUSTOM_SHEET_PROP
            propval.InitNew bag
            propval.SetFlags PropFlag
            propval.SetValue sNumber
            bag.SetProperty "01-Document Number", propval
            Set propval = Nothing
            Set bag = s.GetCustomPropertyBag
            propval.InitNew bag
            propval.SetFlags PropFlag
            propval.SetValue sTitle
            bag.SetProperty "03-Document Title", propval
            Set propval = Nothing
            
        ' if the component is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modCurrentSheet

Private Function GetDictXrecValue(DictName As String, XrecName As String)
On Error GoTo err_label
    Dim oDict As AcadDictionary
    Dim oXRec As AcadXRecord
    Dim dxfCode, dxfData
    Set oDict = ThisDrawing.Dictionaries.item(DictName)
    Set oXRec = oDict.item(XrecName)
    oXRec.GetXRecordData dxfCode, dxfData
    GetDictXrecValue = dxfData(0)
    Exit Function
err_label:
    GetDictXrecValue = Null
End Function

Private Function GetCurrentSheetDwgName() As String
On Error Resume Next
    GetCurrentSheetDwgName = GetDictXrecValue("AcSheetSetData", "SheetDwgName")
End Function

Private Function GetCurrentLayoutName() As String
On Error Resume Next
    GetCurrentLayoutName = GetDictXrecValue("AcSheetSetData", "LayoutName")
End Function

Private Function GetShSetFileName() As String
On Error Resume Next
    GetShSetFileName = GetDictXrecValue("AcSheetSetData", "ShSetFileName")
End Function

Public Function SheetDwgNameOK() As Boolean
    SheetDwgNameOK = (UCase(ThisDrawing.FullName) = UCase(GetCurrentSheetDwgName))
End Function

Private Sub test()
    Debug.Print GetCurrentLayoutName
    Debug.Print GetCurrentSheetDwgName
    Debug.Print SheetDwgNameOK
    Debug.Print GetShSetFileName
End Sub

Public Sub WriteXRec()
  Dim oDict As AcadDictionary
  Dim oXRec As AcadXRecord
  Dim dxfCode(0 To 1) As Integer
  Dim dxfData(0 To 1)
  Set oDict = ThisDrawing.Dictionaries.Add("SampleTest")
  Set oXRec = oDict.AddXRecord("Record1")
  dxfCode(0) = 1: dxfData(0) = "First Value"
  dxfCode(1) = 2: dxfData(1) = "Second Value"
  oXRec.SetXRecordData dxfCode, dxfData
End Sub

Public Sub ReadXRec()
  Dim oDict As AcadDictionary
  Dim oXRec As AcadXRecord
  Dim dxfCode, dxfData
  Set oDict = ThisDrawing.Dictionaries.item("SampleTest")
  Set oXRec = oDict.item("Record1")
  oXRec.GetXRecordData dxfCode, dxfData
  Debug.Print dxfData(0) & vbCrLf & dxfData(1)
End Sub

Sub TestNotWorking()
    Dim ssm As New AcSmSheetSetMgr
    Dim ss As AcSmSheetSet
    Dim ss2 As AcSmSheetSet
    Dim oSheetIter As IAcSmEnumComponent
    Set ss2 = ssm.GetParentSheetSet(ThisDrawing.FullName, ThisDrawing.ActiveLayout.name, ss)
    Debug.Print ss.GetName
    Set ss = Nothing
    Set ss2 = Nothing
    Set ssm = Nothing
End Sub

modDeleteSSProperty

' Delete Sheet Set property to all sheets in the current Sheet Set
Sub unlockss()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Set dbIter = ssm.GetDatabaseEnumerator
    Set db = dbIter.Next
    Call db.UnlockDb(db, True)
End Sub


Sub DeleteSheetSetProperty()
Dim i As Integer
i = SheetSetsOpen
If i > 1 Then
    MsgBox "More than one Sheet Set are open. Make sure only one is open.", vbCritical
    Exit Sub
ElseIf i = 0 Then
    MsgBox "No Sheet Set is open. Make sure one is open.", vbCritical
    Exit Sub
End If
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As IAcSmDatabase
    Dim ss As AcSmSheetSet
    
    If ssm Is Nothing Then
        MsgBox "Something wrong here: 1", vbCritical
        Exit Sub
    End If
    Set dbIter = ssm.GetDatabaseEnumerator
    If dbIter Is Nothing Then
        MsgBox "Something wrong here: 2", vbCritical
        Exit Sub
    End If
    dbIter.Reset
    
    'get the Database of the first sheetset
    Set db = dbIter.Next
    If db Is Nothing Then
        MsgBox "No Sheet Set open", vbCritical
        Exit Sub
    End If
    'get the sheetset
    Set ss = db.GetSheetSet
    If ss Is Nothing Then
        MsgBox "Cannot get the Sheet Set", vbCritical
        Exit Sub
    End If
    Set oSheetIter = ss.GetSheetEnumerator
    If oSheetIter Is Nothing Then
      Return
    End If
    ' lock the database
    Dim lockStatus As AcSmLockStatus
    Let lockStatus = db.GetLockStatus
    If lockStatus = AcSmLockStatus_UnLocked Then
      db.LockDb db
    Else
        
        Dim sUserName As String
        Dim sMachineName As String
        db.GetLockOwnerInfo sUserName, sMachineName
        MsgBox "The Sheet Set is locked by " & sUserName & " at " & sMachineName, vbCritical
        Exit Sub
    End If

    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    
    Call LoopThroughSheets(compEnum)
    
    ' unlock the database
    Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Debug.Print comp.GetName & "," & comp.GetDesc
            Dim oProp2 As New AcSmCustomPropertyValue
            PropFlag = CUSTOM_SHEET_PROP
            oProp2.InitNew comp
            oProp2.SetFlags PropFlag
            oProp2.SetValue Null
            ' Remove this property by setting it to Null
            comp.GetCustomPropertyBag.SetProperty "01-Document Number", oProp2
            Set oProp2 = Nothing
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modSSM

Public Function SheetSetsOpen() As Integer
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As AcSmDatabase
    Dim i As Integer
    
    Set dbIter = ssm.GetDatabaseEnumerator
    dbIter.Reset
    
    Set db = dbIter.Next
    i = 0
    Do While Not db Is Nothing
        i = i + 1
        Set db = Nothing
        Set db = dbIter.Next
    Loop
    SheetSetsOpen = i
    
End Function



' List the Sheet Selections that exists in the current Sheet Set
Sub ListSheetSelections()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As AcSmDatabase
    Dim ss As AcSmSheetSet
    Dim sheetSelSet As IAcSmSheetSelSet
    Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
    
    Set dbIter = ssm.GetDatabaseEnumerator
    dbIter.Reset
    Set db = dbIter.Next
    Set ss = db.GetSheetSet
    Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
    Set sheetSelSet = sheetSelSetsEnum.Next
    Do While Not sheetSelSet Is Nothing
        Debug.Print sheetSelSet.GetName
        Set sheetSelSet = Nothing
        Set sheetSelSet = sheetSelSetsEnum.Next
    Loop
End Sub

' List the Sheet Selections that exists in the current Sheet Set and the Sheets and Subsets
Sub ListSheetSelectionsAndContent()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As AcSmDatabase
    Dim ss As AcSmSheetSet
    Dim sheetSelSet As IAcSmSheetSelSet
    Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
    Dim sheetSelSetEnum As IAcSmEnumComponent
    Dim item As IAcSmPersist
    Dim oSubSet As AcSmSubset
    Dim oSheet As AcSmSheet
    
    Set dbIter = ssm.GetDatabaseEnumerator
    dbIter.Reset
    Set db = dbIter.Next
    Set ss = db.GetSheetSet
    Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
    Set sheetSelSet = sheetSelSetsEnum.Next
    Do While Not sheetSelSet Is Nothing
        Debug.Print "Sheet Selection: " & sheetSelSet.GetName
        
        Set sheetSelSetEnum = sheetSelSet.GetEnumerator
        sheetSelSetEnum.Reset
        Set item = sheetSelSetEnum.Next
        Do While Not item Is Nothing
            If item.GetTypeName = "AcSmSubset" Then
                Set oSubSet = item
                Debug.Print " Subset: " & oSubSet.GetName
            ElseIf item.GetTypeName = "AcSmSheet" Then
                Set oSheet = item
                Debug.Print " Sheet: " & oSheet.GetName
            End If
            Set item = Nothing
            Set item = sheetSelSetEnum.Next
        Loop
        
        Set sheetSelSet = Nothing
        Set sheetSelSet = sheetSelSetsEnum.Next
    Loop
End Sub


' List the Sheet Selections that exists in the current Sheet Set and the Sheets and Subsets
' It also list the sheets that are in the subsets
Sub ListSheetSelectionsAndContent2()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As AcSmDatabase
    Dim ss As AcSmSheetSet
    Dim sheetSelSet As IAcSmSheetSelSet
    Dim sheetSelSetsEnum As IAcSmEnumSheetSelSet
    Dim sheetSelSetEnum As IAcSmEnumComponent
    Dim item As IAcSmPersist
    Dim oSubSet As AcSmSubset
    Dim oSheet As AcSmSheet
    
    Set dbIter = ssm.GetDatabaseEnumerator
    dbIter.Reset
    Set db = dbIter.Next
    db.LockDb db
    Set ss = db.GetSheetSet
    Set sheetSelSetsEnum = ss.GetSheetSelSets.GetEnumerator
    Set sheetSelSet = sheetSelSetsEnum.Next
    Do While Not sheetSelSet Is Nothing
        Debug.Print "Sheet Selection: " & sheetSelSet.GetName
        If sheetSelSet.GetName = "SCRIPT" Then
            Set sheetSelSetEnum = sheetSelSet.GetEnumerator
            sheetSelSetEnum.Reset
            Set item = sheetSelSetEnum.Next
            Do While Not item Is Nothing
                If item.GetTypeName = "AcSmSubset" Then
                    Set oSubSet = item
                    Debug.Print " Subset: " & oSubSet.GetName
                    
                    Dim compEnum As IAcSmEnumComponent
                    ' get component enumerator
                    Set compEnum = oSubSet.GetSheetEnumerator
                    LoopThroughSheets compEnum
                ElseIf item.GetTypeName = "AcSmSheet" Then
                    Set oSheet = item
                    Debug.Print " Sheet: " & oSheet.GetName
                    
                    ChangeProperties "17-Approved", "JIMMY BERGMARK", oSheet
                    
                End If
                Set item = Nothing
                Set item = sheetSelSetEnum.Next
            Loop
        End If
        
        Set sheetSelSet = Nothing
        Set sheetSelSet = sheetSelSetsEnum.Next
    Loop
     Call db.UnlockDb(db, True)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            Debug.Print "  Sheet: " & s.GetName
            
            ChangeProperties "17-Approved", "JIMMY BERGMARK", s
            
            ' Debug.Print s.GetLayout.GetFileName
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

Private Sub ChangeProperties(sProperty As String, sValue As String, ByVal oSheet As AcSmSheet)
    Dim propval As New AcSmCustomPropertyValue
    Dim bag As IAcSmCustomPropertyBag
    Set bag = oSheet.GetCustomPropertyBag
    PropFlag = CUSTOM_SHEET_PROP
    
    propval.InitNew bag
    propval.SetFlags PropFlag
    propval.SetValue sValue
    bag.SetProperty sProperty, propval
    Set propval = Nothing
    Set bag = Nothing
End Sub

modSSMChangeNumberTitle

Dim ssm As ACSMCOMPONENTS16Lib.AcSmSheetSetMgr
Dim db As AcSmDatabase
Dim ss As AcSmSheetSet

Sub changeNameNumber()
    Set ssm = CreateObject("AcSmComponents.AcSmSheetSetMgr")
    ' open the database
    Set db = ssm.OpenDatabase("C:\Program Files\AutoCAD 2005\Sample\Sheet Sets\Architectural\IRD Addition.dst", True)
    ' lock the database
    Call db.LockDb(db)

    ' get the sheetset
    Set ss = db.GetSheetSet
    Dim compEnum As IAcSmEnumComponent
    ' get component enumerator
    Set compEnum = ss.GetSheetEnumerator
    Call LoopThroughSheets(compEnum)
    ' unlock the database
    Call db.UnlockDb(db, True)
    ' close
    Call ssm.Close(db)
End Sub

Private Sub LoopThroughSheets(ByVal compEnum As IAcSmEnumComponent)
    Dim comp As IAcSmComponent
    Set comp = compEnum.Next()
    ' loop through till the component is Nothing
    Do While Not comp Is Nothing
        On Error Resume Next
        Debug.Print comp.GetName & "," & comp.GetDesc
        On Error GoTo 0
        ' if the component is a sheet, then...
        If comp.GetTypeName = "AcSmSheet" Then
            Dim s As AcSmSheet
            Set s = comp
            ' set the new number
            s.SetNumber "0000"
            ' set the new name
            s.SetTitle "MySheet"
        ' if the componnet is a subset then ...
        ElseIf comp.GetTypeName = "AcSmSubset" Then
            Dim sset As AcSmSubset
            Set sset = comp
            ' loop through all the sheets.
            Call LoopThroughSheets(sset.GetSheetEnumerator)
        End If
        ' next
        Set comp = compEnum.Next()
    Loop
End Sub

modWhoIsLockingSS

' Show who is locking the Sheet Set
' Doesn't seem to work because when db is nothing it is locked and it cannot get the lock owner info

Sub WhoIsLocking()
    Dim ssm As New AcSmSheetSetMgr
    Dim dbIter As IAcSmEnumDatabase
    Dim db As AcSmDatabase
    Dim sUserName As String
    Dim sMachineName As String
    
    Set dbIter = ssm.GetDatabaseEnumerator
    dbIter.Reset
    
    Set db = dbIter.Next
    Do While Not db Is Nothing
        Dim lockStatus As AcSmLockStatus
        lockStatus = db.GetLockStatus
        If lockStatus = AcSmLockStatus_Locked_Remote Then
            Dim ss As AcSmSheetSet
            Dim ssn As String
            Set ss = db.GetSheetSet
            ssn = ss.GetName
            db.GetLockOwnerInfo sUserName, sMachineName
            MsgBox "The Sheet Set '" & ssn & "' is locked by " & sUserName & " at " & sMachineName, vbExclamation
        End If
        Debug.Print db.GetFileName
        Set db = Nothing
        Set db = dbIter.Next
    Loop
    Set dbIter = Nothing
End Sub