Adding a stamp/sketch/symbol to a .idw and editing the date

[Anonymous]

Hello Eveyone,

I've been pulling my hair out for the afternoon trying to find any method what-so-ever to add our drawing approval stamp automatically when a user runs a macro. It doesn't matter how or what, i just need our stamp to appear and the date in the textbox to update to now(). Currently I have:

Public Sub StampDWG()
Dim oDWG As DrawingDocument
Dim dateBox As TextBox
If ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
    MsgBox "This program must be run on an AutoBin generated drawing."
    Exit Sub
    End If
Set oDWG = ThisApplication.ActiveDocument

DD = Day(Now())
MM = Month(Now())
yy = Year(Now())
dateStr = "("
If DD < 10 Then
    dateStr = dateStr & "0" & DD & "/"
    GoTo addMonth
    End If
dateStr = dateStr & DD & "/"
addMonth:
If MM < 10 Then
    dateStr = dateStr & "0" & MM & "/"
    GoTo addYear
    End If
dateStr = dateStr & MM & "/"
addYear:
dateStr = dateStr & yy & ")" 'dateStr basically becomes example (05/31/2011)

Call oDWG.Sheets(1).SketchedSymbols.Add("MMG_APPROVAL_STAMP", ThisApplication.TransientGeometry.CreatePoint2d(6 * 2.54, 3.4 * 2.54), 0, 0.8)

Dim oSymbol As SketchedSymbol
For Each oSymbol In oDWG.ActiveSheet.SketchedSymbols
Debug.Print oSymbol.Name
If oSymbol.Definition.Name = "MMG_APPROVAL_STAMP" Then
    oSymbol.Definition.Sketch.TextBoxes(4).FormattedText = dateStr

...

On the last line I get an error

Run-time error '-2147467259 (80004005)':

Method 'FormattedText' of object 'TextBox' failed

Same error when using .text method

I added this and get an error on the .edit line

If oSymbol.Definition.Name = "MMG_APPROVAL_STAMP" Then
    oSymbol.Definition.Sketch.Edit
    oSymbol.Definition.Sketch.TextBoxes(4).FormattedText = dateStr
    oSymbol.Definition.Sketch.ExitEdit

End If

i get the same error number saying the method failed.

[dean.morrison · Accepted solution]

You need to pass the strings to the function aswell.

If you are using a sketched symbol with multiple prompted entries then just add more to the array.

Dim sPromptStrings(1) As String       'Array has 1 value only!
sPromptStrings(0) = dateStr              'Value 1

Set oSketchedSymbol = oDWG.Sheets(1).SketchedSymbols.Add("MMG_APPROVAL_S​TAMP", ThisApplication.TransientGeometry.CreatePoint2d(6 * 2.54, 3.4 * 2.54), 0, 0.8, sPromptStrings)

Hopefully this fixes your problem.

[Anonymous · Accepted solution]

thanks for the help! youre a life saver!!