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

Crack any SOLIDWORKS password-protected VBAmacro with screenshots

Disclaimer: The information shared in this article is intended to show how easy it is to unlock the password protection…

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

Traverse Assembly Tree Recursively -SOLIDWORKS API

This topic is most definitely a recurring one. I find myself having to go back to old pieces of code…

Read Story

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