Add watermark to your drawings – Macro

This macro adds a watermark to the active sheet of the active drawing document:

'www.bluebyte.biz

Public Enum swVerticalJustification_e
swVerticalJustificationNone = 0
swVerticalJustificationBottom = 3
swVerticalJustificationMiddle = 2
swVerticalJustificationTop = 1
End Enum

Public Enum swTextJustification_e
swTextJustificationCenter = 2
swTextJustificationLeft = 1
swTextJustificationNone = 0
swTextJustificationRight = 3
End Enum

Public Enum swDocumentTypes_e
swDocASSEMBLY = 2
swDocDRAWING = 3
swDocIMPORTED_ASSEMBLY = 7
swDocIMPORTED_PART = 6
swDocLAYOUT = 5
swDocNONE = 0
swDocPART = 1
swDocSDM = 4
End Enum

Public Enum swLeaderStyle_e
swNO_LEADER = 0
End Enum

Option Explicit

Sub main()
    ''''''''''''''''''''
    Dim watermarkText As String
    'set watermark text here
    watermarkText = "DRAFT"
    ''''''''''''''''''''
    
    Dim swApp As Object
    Dim swModel As Object
    Dim swDraw As Object
    Dim swSheet As Object
    
    Set swApp = Application.SldWorks
    
    
    If swApp Is Nothing Then
    MsgBox ("Failed to get the solidworks application.")
    Exit Sub
    End If
    
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
    swApp.SendMsgToUser "No document open."
    Exit Sub
    End If
    
    If swModel.GetType() <> swDocumentTypes_e.swDocDRAWING Then
    swApp.SendMsgToUser "Macro only runs on drawing documents."
    Exit Sub
    End If
    
    Set swDraw = swModel
    
    Dim addRet As Boolean
    addRet = AddWatermark(swDraw, watermarkText)
    
    If addRet = False Then
    
    swApp.SendMsgToUser "Failed to get add watermark"
    
    End If
    
    
End Sub
    
    
    
    Private Function AddWatermark(ByVal swModel As Object, ByVal watermarkText As String) As Boolean
    On Error GoTo handler:
    Dim swWidth As Double
    Dim swHeight As Double
    Dim swDrawingDoc As Object
    Dim selectionMgr As Object
    Dim swSheet As Object
    Dim swAnn As Object
    Dim swNote As Object
    Dim swTextFormat As Object
    
    Set swDrawingDoc = swModel
    Set swSheet = swDrawingDoc.GetCurrentSheet()
    Dim props As Variant
    props = swSheet.GetProperties2()
    swWidth = props(5)
    swHeight = props(6)
    
    swDrawingDoc.EditTemplate
    
    swModel.ClearSelection2 (True)
    
    'attempt to get existing note and delete if it exists in the same position
    Dim selectionRet As Boolean
    selectionRet = swModel.Extension.SelectByID2("", "NOTE", swWidth * 0.5, swHeight * 0.5, False, -1, 0, Nothing, 0)
    If (selectionRet) Then
       swModel.DeleteSelection False
    End If
    Set swNote = swModel.InsertNote("" + watermarkText)
    swNote.BehindSheet = True
    If Not swNote Is Nothing Then
        swNote.SetBalloon 0, 0
        Set swAnn = swNote.GetAnnotation()
        swAnn.SetLeader3 swLeaderStyle_e.swNO_LEADER, 0, True, False, False, False
        Set swTextFormat = swModel.GetUserPreferenceTextFormat(0)
        swTextFormat.Escapement = 0.4
        swTextFormat.CharHeight = 0.04
        swAnn.SetTextFormat 0, False, swTextFormat
        swAnn.SetPosition swWidth * 0.5, swHeight * 0.5, 0
        swNote.SetTextJustification (swTextJustification_e.swTextJustificationCenter)
        swNote.SetTextVerticalJustification (swVerticalJustification_e.swVerticalJustificationMiddle)
    End If
    swModel.ClearSelection2 (True)
    swDrawingDoc.EditTemplate
    swDrawingDoc.EditSheet
    AddWatermark = True
    swModel.ForceRebuild3 False
    
    Exit Function
handler:
    AddWatermark = False
End Function