Delete Revision tables on all sheets & insert a blank one on the first sheet

[berg_lauritz]

Came across something the other day, so here is the quick & dirty (not cleaned up) code for a macro that deletes all revision tables on all sheets & inserts a new blank one on the first sheet.

Modify the

Code: Select all

RevTablePath

variable with your template.

Credits go to:
initial code from the SWYM(P) here
Further reading (in German)

Enjoy!

Code: Select all

Option Explicit


Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSelData As SldWorks.SelectData
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim swFeat As SldWorks.Feature
Dim swTableAnn As SldWorks.TableAnnotation
Dim revTableFeat As SldWorks.RevisionTableFeature
Dim swAnn As SldWorks.Annotation
Dim vSheetNames As Variant
Dim boolstatus As Boolean
Dim bRet As Boolean
Dim i As Long
Dim RevTablePath As String
Dim RevTableAnn As SldWorks.RevisionTableAnnotation

 
Sub main()

RevTablePath = "C:\your path\your revision table template.sldrevtbt"

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData


vSheetNames = swDraw.GetSheetNames
For i = 0 To UBound(vSheetNames)
    swDraw.ActivateSheet vSheetNames(i)
'    Debug.Print vSheetNames(i)
    Set swSheet = swDraw.GetCurrentSheet
    Set RevTableAnn = swSheet.RevisionTable
    
    If Not RevTableAnn Is Nothing Then
'        Debug.Print "Revision Table is SOMETHING! Double check for revTableFeat now!"
        Set revTableFeat = RevTableAnn.RevisionTableFeature
        If revTableFeat Is Nothing Then
'            Debug.Print "Revision table feature is nothing but a revision table exists!"
            Set swTableAnn = RevTableAnn
            Set swAnn = swTableAnn.GetAnnotation
        
            boolstatus = swAnn.Select3(False, swSelData)
            bRet = swModelDocExt.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed)
            Debug.Print "Revision table annotation deleted? " & bRet
        

        Else
'            Debug.Print "Revision table feature is present! Delete it!"
            Set swFeat = RevTableAnn.RevisionTableFeature.GetFeature
            bRet = swFeat.Select2(False, 0)
            bRet = swModelDocExt.DeleteSelection2(swDeleteSelectionOptions_e.swDelete_Absorbed)
        End If
    Else
'        Debug.Print "Revision Table is nothing! Sheet can be skipped!"
    End If
    

Next

' Activate first sheet
swDraw.ActivateSheet vSheetNames(0)
' Insert rev table
Set RevTableAnn = swSheet.InsertRevisionTable2(True, 0#, 0#, swBOMConfigurationAnchor_BottomLeft, RevTablePath, swRevisionTable_TriangleSymbol, True)

End Sub