Add watermark to your drawings – Macro

Amen Jlili
Add watermark macro in action.

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


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
swDocDRAWING = 3
swDocLAYOUT = 5
swDocNONE = 0
swDocPART = 1
swDocSDM = 4
End Enum

Public Enum swLeaderStyle_e
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)
    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)
    AddWatermark = True
    swModel.ForceRebuild3 False
    Exit Function
    AddWatermark = False
End Function

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


Leave a Reply

More great articles


Early binding vs Late Binding: How to write macros that will always run with no errors

TLDR: Here's what you need to know about Early Binding Vs Late Binding Use early binding for writing macros. It…

Read Story

Delete dangling dimensions VBA macro

This macro deletes all dangling dimensions from all sheets in the active drawing document. ' Delete all dangling dimensions '…

Read Story

Delete all properties for the active configuration – SOLIDWORKS MACRO

The following macro deletes all the properties from the active configuration. The macro is written used late-binding so it is…

Read Story

© 2021 Blue Byte Systems, Inc. - Our products and services are coded with ❤️️ in Vancouver, BC