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?
Solved! Go to Solution.
Solved by vkulikajevas. Go to Solution.
Solved by JelteDeJong. Go to Solution.
You may have to provide more specific details about the scenario you want.
Wesley Crihfield
(Not an Autodesk Employee)
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.
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)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
Thank You @JelteDeJong for reply!
"Drawing-Test" is the drawing file, where I want to replace the title blocks.
I get this error:
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)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
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)
**** 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)
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.
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)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
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!
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
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
Thank You @JelteDeJong ! Really great illogic rule. Hope this thread also helps to everyone who search this as a solution!
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!
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()
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
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
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
@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?
Can't find what you're looking for? Ask the community or share your knowledge.