Change Title Block with iLogic from another file

[vkulikajevas]

Hey. I am looking for a way to change all active document sheet Title Blocks using iLogic from a predefined template file (Standard). Rule should find location of file, and location of named title block and insert it into all new drawing files. Can this be done with a rule?

[WCrihfield]

You may have to provide more specific details about the scenario you want.

• Will the 'Template' drawing file already be open (like maybe in the background), when this rule is ran, or do you want the rule to find this 'Template' drawing file?
  • If you want the rule to find it, do you want to specify its full file name within the rule, or find it another way?
• Will this rule be an external rule or local rule?
  • If local, will it be in the 'Template' drawing, or in the other drawing that you want to make the changes to?
• You said "rule should find location of file"...is this referring to the 'Template' drawing, or the target drawing which is to be changed?
• You said "insert it (the named title block it finds) into all new drawing files"...do you mean that you intend to put this rule under the "New Document" event of the "Drawings" tab of the Event Triggers dialog box, or some other meaning?  This sounds like the primary use of a 'Template' to me...when I create a 'new' drawing, it is being based on a 'Template' already, which could be this 'Template', so it would already be creating its new sheets with your named title block, if set-up that way in the template.

[vkulikajevas]

Hello @WCrihfield. Thank you for your attention to this post.

This rule is useful, because i get drawings  with different title block copies. With already made drawings. Rule could change all together.

I am looking for a rule that can change title blocks for opened current drawing sheets. Reference to template should be indicated with exact location "c:\users....". The title of the title block is in template and name is reffered accordingly. The template file is not opened.

[JelteDeJong]

is this what you are looking for?

Dim doc As DrawingDocument = ThisDoc.Document

' seacrh for template path in project file
Dim designProject As DesignProject = ThisApplication.DesignProjectManager.ActiveDesignProject
Dim templatesPath As String = designProject.TemplatesPath

' guess the template name and open it.
Dim templateFileName As String = IO.Path.Combine(templatesPath, "Standard.idw")
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("ANSI - Large")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

' replace the title block
doc.ActiveSheet.TitleBlock.Delete()
doc.ActiveSheet.AddTitleBlock(newTitleBlok)

[vkulikajevas]

Thank You @JelteDeJong for reply!

"Drawing-Test" is the drawing file, where I want to replace the title blocks. 

I get this error:

[JelteDeJong]

The name of the file that you want to change is not important. I could not reproduce the exception. did you change the name of your template and the name of your title block in the rule? If you run this rule what is the last msgbox that you get before the exception?

Dim doc As DrawingDocument = ThisDoc.Document

' seacrh for template path in project file
Dim designProject As DesignProject = ThisApplication.DesignProjectManager.ActiveDesignProject
MsgBox("ActiveDesignProject: " + designProject.Name)
Dim templatesPath As String = designProject.TemplatesPath
MsgBox("templatesPath: " + templatesPath)

' guess the template name and open it.
Dim templateFileName As String = IO.Path.Combine(templatesPath, "[YOUR TEMPLATE NAME HERE]")
MsgBox("templateFileName: " + templateFileName)
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("[YOUR TITLEBLOCK NAME HERE]")
MsgBox("templateTitleBloc: " + templateTitleBloc.Name)
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

' replace the title block
doc.ActiveSheet.TitleBlock.Delete()
doc.ActiveSheet.AddTitleBlock(newTitleBlok)

[vkulikajevas]

Hello @JelteDeJong , This is your modified code, that I used:

Dim doc As DrawingDocument = ThisDoc.Document

' seacrh for template path in project file
Dim designProject As DesignProject = ThisApplication.DesignProjectManager.ActiveDesignProject
MsgBox("ActiveDesignProject: " + designProject.Name)
'Dim templatesPath As String = designProject.TemplatesPath
Dim templatesPath As String = "C:\Users\Valdas\Desktop\"
MsgBox("templatesPath: " + templatesPath)

' guess the template name and open it.
Dim templateFileName As String = IO.Path.Combine(templatesPath, "Title Template.dwg")
MsgBox("templateFileName: " + templateFileName)
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEST_TITLE_0")
MsgBox("templateTitleBloc: " + templateTitleBloc.Name)
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

' replace the title block
doc.ActiveSheet.TitleBlock.Delete()
doc.ActiveSheet.AddTitleBlock(newTitleBlok)

I don't really need the project location, since the template will be stored outside of project. So that is where I indicate exact location of folder, then file, then template. But error is the same. (Title Template.dwg is .dwg, not .idw)

[vkulikajevas]

**** UPDATE ****

Error resides here:

Problem when there is no title block in the drawing, it shows as a missing object. Can there be added syntax to check if title exist?

' replace the title block
doc.ActiveSheet.TitleBlock.Delete()
doc.ActiveSheet.AddTitleBlock(newTitleBlok)

[A.Acheson]

You could use a try catch statement around the delete section. This should rarely be a case as it usually only comes up in testing and most drawings will have one. Or use an on error resume next statement for use in a for loop. 

Here is another post that works with sheet formats and copying titleblocks and looping through the whole drawing, at the moment you are only targeting the active sheet. 

https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/ilogic-to-replace-titleblock-from-templ...

[JelteDeJong]

I guess the best way would be to check if there is a title block. like this:

Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\Valdas\Desktop\Title Template.dwg"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEST_TITLE_0")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

' replace the title block
Dim oldTitleblock As TitleBlock = doc.ActiveSheet.TitleBlock
If (oldTitleblock IsNot Nothing) Then
    oldTitleblock.Delete()
End If
doc.ActiveSheet.AddTitleBlock(newTitleBlok)

[vkulikajevas]

Thank You @JelteDeJong ! One last favor to add to this rule, ! can it be modified to run on all drawing sheets? (like for every sheet, repeat change of title block?) This is the last modification here! Thank you really much in advance!

[JelteDeJong · Accepted solution]

I did not test this but i guess this would work:

Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\Valdas\Desktop\Title Template.dwg"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEST_TITLE_0")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

For Each sheet As Sheet In doc.Sheets
    Dim oldTitleblock As TitleBlock = Sheet.TitleBlock
    If (oldTitleblock IsNot Nothing) Then
        oldTitleblock.Delete()
    End If
    Sheet.AddTitleBlock(newTitleBlok)
Next

[vkulikajevas]

Thank You @JelteDeJong ! Really great illogic rule. Hope this thread also helps to everyone who search this as a solution!

[vkulikajevas]

Hello, once more @JelteDeJong . There is a slight problem... 
When the title block  has a prompted Text Input (All of titles that I use, have this), I get an error in this rule, and no title is pasted.

I have read on forums that "Execute 2(True)" might solve, but I could not make it work with this code. Can this rule skip the prompted text inputs and paste the title block? I would also accept it as a 2nd solution. Thank You!

[smilinger]

ThisDrawing.ResourceFileName = ThisApplication.DesignProjectManager.ActiveDesignProject.TemplatesPath & "\Resources\TitleAndBorders.idw"
'ThisDrawing.ResourceFileName = "C:\Path\To\The\Resource\File.idw"
ThisDrawing.KeepExtraResources = False

Dim doc As DrawingDocument = ThisDrawing.Document

For Each sht As Sheet In doc.Sheets
	sht.Activate()
'	ActiveSheet.Border = "A2"
	ActiveSheet.TitleBlock = "My Title Block"
'	ActiveSheet.SetTitleBlock("My Title Block", "promptedEntry1", "promptedEntry2")
Next

doc.Sheets(1).Activate()

[vkulikajevas · Accepted solution]

Posting working code here (2nd solution - modified @JelteDeJong  code). Solved issues:

Check if title has prompts.

If not, pastes title without prompts. If yes, pastes with defined prompts.

Solved iteration for sheets. There was error on multiple sheet, because of Active sheet syntax missing.

'' --- MAIN --- Change All Titles  - ALL SHEETS
'On Error Resume Next 'In case no prompted entries
Dim doc As Inventor.DrawingDocument
doc = ThisDoc.Document

'Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\...\Location.dwg"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' Prompted entries as ""
'Dim sPromptStrings(1) As String '= ""
'sPromptStrings(0) = "TEST"

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEMPLATE")
'Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("T01")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

'Dim actSheet As Sheet = ThisApplication.ActiveDocument.ActiveSheet
'For Each oSheet In doc.Sheets

For Each oSheet As Sheet In doc.Sheets
	ActiveSheet = ThisDrawing.Sheet(oSheet.Name) 'Must be for WHOLE RULE TO WORK!


    Dim oldTitleblock As TitleBlock = oSheet.TitleBlock
    If (oldTitleblock IsNot Nothing) Then
        oldTitleblock.Delete()
    End If

'-----START prompt test
Dim sPromptStrings(0 To 17) As String

If (sPromptStrings Is Nothing) Then  'check if title has prompted entries, if not, then paste with no entries
	oSheet.AddTitleBlock(newTitleBlok)
Else

sPromptStrings(0) = ""
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) = ""
'---

	oSheet.AddTitleBlock(newTitleBlok, , sPromptStrings)
	'Sheet.AddTitleBlock(newTitleBlok)
End If
Next

Posting  

[JelteDeJong]

I'm a bit late to the party but this is what I would do. This way it doesn't matter how many "PromptString" you have in your title block.

Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\Valdas\Desktop\Title Template.dwg"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEST_TITLE_0")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

For Each sheet As Sheet In doc.Sheets
    Sheet.Activate()
    Dim oldTitleblock As TitleBlock = Sheet.TitleBlock
    If (oldTitleblock IsNot Nothing) Then
        oldTitleblock.Delete()
    End If

    Dim numberOfEntries As Integer = 1
    For Each tb As Inventor.TextBox In newTitleBlok.Sketch.TextBoxes
        If (tb.FormattedText.Contains("Prompt")) Then
            numberOfEntries = numberOfEntries + 1
        End If
    Next
    Dim sPromptStrings(numberOfEntries - 1) As String
    For i = 0 To sPromptStrings.Count - 1
        sPromptStrings(i) = ""
    Next

    If (numberOfEntries > 0) Then
        Sheet.AddTitleBlock(newTitleBlok,  , sPromptStrings)
    Else
        Sheet.AddTitleBlock(newTitleBlok)
    End If
Next 

[johan.degreef]

---

@JelteDeJong wrote:

I'm a bit late to the party but this is what I would do. This way it doesn't matter how many "PromptString" you have in your title block.

Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\Valdas\Desktop\Title Template.dwg"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

' copy your titleblock to original drawing
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("TEST_TITLE_0")
Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)
' close the template document
templateDoc.Close(True)

For Each sheet As Sheet In doc.Sheets
    Sheet.Activate()
    Dim oldTitleblock As TitleBlock = Sheet.TitleBlock
    If (oldTitleblock IsNot Nothing) Then
        oldTitleblock.Delete()
    End If

    Dim numberOfEntries As Integer = 1
    For Each tb As Inventor.TextBox In newTitleBlok.Sketch.TextBoxes
        If (tb.FormattedText.Contains("Prompt")) Then
            numberOfEntries = numberOfEntries + 1
        End If
    Next
    Dim sPromptStrings(numberOfEntries - 1) As String
    For i = 0 To sPromptStrings.Count - 1
        sPromptStrings(i) = ""
    Next

    If (numberOfEntries > 0) Then
        Sheet.AddTitleBlock(newTitleBlok,  , sPromptStrings)
    Else
        Sheet.AddTitleBlock(newTitleBlok)
    End If
Next 

---

Thanks Jelte!

Does this rule overwrite the titleblock if it has the same name?