addtitleblock --simplest test

[Anonymous]

I tried to add title block in many ways (using macro) but without success.

Here is a code:

Sub test()
    Dim odrawdoc As DrawingDocument
    Set odrawdoc = ThisApplication.ActiveDocument
    Dim oNewTitleBlockDef As TitleBlockDefinition
    Dim oSheet As Sheet
    Dim titleblock As titleblock
    Set oSheet = odrawdoc.ActiveSheet
    Set oNewTitleBlockDef = odrawdoc.TitleBlockDefinitions.Item(1)
    Set titleblock = oSheet.addTitleBlock(oNewTitleBlockDef)
'    Call oSheet.addTitleBlock(oNewTitleBlockDef)
    
    
End Sub

I got run time error 5 on line :

Set titleblock = oSheet.addTitleBlock(oNewTitleBlockDef)

 what is wrong?

Michal

[GeorgK]

Public Sub addMyTitleBlock()
Dim oDrawDoc As DrawingDocument
'Ensure the active document is a drawing
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawDoc = ThisApplication.ActiveDocument
' get the Title blocks (definitions)
Dim oTitleBlks As TitleBlockDefinitions
Set oTitleBlks = oDrawDoc.TitleBlockDefinitions
' add a new title block definition
Dim oTitleBlk As TitleBlockDefinition
Set oTitleBlk = oTitleBlks.Add("myxTitleBlock")
End If
End Sub

[Anonymous]

Ok, maybe I use wrong function.

I'm trying to put title block on drawing.

I'have two title blocks in template, and I want to put one of them to sketch.

I see that your code is trying to add next table to sketch resources.

[Anonymous]

I mixed your code with mine:

Public Sub addMyTitleBlock()
Dim oDrawDoc As DrawingDocument
'Ensure the active document is a drawing
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawDoc = ThisApplication.ActiveDocument
' get the Title blocks (definitions)
Dim oTitleBlks As TitleBlockDefinitions
Set oTitleBlks = oDrawDoc.TitleBlockDefinitions
' add a new title block definition
Dim oTitleBlk As TitleBlockDefinition
Set oTitleBlk = oTitleBlks.Add("myxTitleBlock")

Dim osheet As Sheet
Set osheet = oDrawDoc.ActiveSheet

Dim otitleblock As titleblock
Set oNewTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("myxTitleBlock")
Set otitleblock = osheet.AddTitleBlock(oNewTitleBlockDef)
    
End If
End Sub

And your myxtitleblock has been added to my Sheet.

Now I see that I have problems with prompts probably. I was sure if I leave it empty then is OK.

I will try to fix it and let you know.

[MechMachineMan]

As it says in API Help, if the titleblock that you are trying to add has prompted entries in it, you must supply them as arguments to the .AddTitleBlock line or else the method will fail.

[Anonymous · Accepted solution]

For all asking in the future:

Public Sub addMyTitleBlock()
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
' get the Title blocks (definitions)
Dim oTitleBlks As TitleBlockDefinitions
Set oTitleBlks = oDrawDoc.TitleBlockDefinitions

Dim osheet As Sheet
Set osheet = oDrawDoc.ActiveSheet


Dim sPromptStrings(1 To 17) As String
sPromptStrings(1) = ""
sPromptStrings(2) = ""
sPromptStrings(3) = ""
sPromptStrings(4) = ""
sPromptStrings(5) = ""
sPromptStrings(6) = ""
sPromptStrings(7) = ""
sPromptStrings(8) = ""
sPromptStrings(9) = ""
sPromptStrings(10) = ""
sPromptStrings(11) = ""
sPromptStrings(12) = ""
sPromptStrings(13) = ""
sPromptStrings(14) = ""
sPromptStrings(15) = ""
sPromptStrings(16) = ""
sPromptStrings(17) = ""


Dim otitleblock As titleblock
'Set oNewTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item("myxTitleBlock")
'Set otitleblock = osheet.AddTitleBlock(oNewTitleBlockDef)
Set oNewTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item(1) 'here you may put your titleblock name in ("my titleblock name")
Set otitleblock = osheet.AddTitleBlock(oNewTitleBlockDef, , sPromptStrings)

End Sub

What is important for me :  I had to write lines like 

sPromptStrings(17) = ""

without them it is not working.

In my example I have 17 text prompts.

Thanks for directing me ... 🙂

[MechMachineMan]

Dont forget to mark as solution and give kudos where due so that others can find this solved post if they search for it.