Add watermark to your drawings – Macro

Authored by Amen Jlili
Updated December 20, 2020
Published June 15, 2020
Topics covered: macro, vba, watermark

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("<FONT color=0x000000ff><FONT style=B>" + 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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

'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("<FONT color=0x000000ff><FONT style=B>" + 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

Think you caught a bug or want to get a custom modification? Contact us here.

Found an error or have suggestions? Send corrections via the comment section below. 👇

Amen Jlili

Amen Jlili is the founder and technical director of Blue Byte Systems Inc., a software company in Vancouver, Canada, specializing in automating SOLIDWORKS and PDM. With over a decade of experience, he has authored several courses and open-source frameworks related to the SOLIDWORKS API. His leadership ensures that Blue Byte Systems prioritizes customer satisfaction and delivers high-quality software and CAD design solutions.

All Posts

📝 Subscribe Now and join our community for goodies and more!

📞 Phone: (778) 200-2012

🌐 Website: bluebyte.biz

📍 Mailing Address: 170-422 Richards St, Vancouver, BC, V6B 2Z4, Canada