Batch replace titleblock

[morrenengineering]

some of my clients want to have their own titleblock. Then nothing changes to the properties, but to the appearance. I already made some code for this, but it doesn't work. It crashes on the part from line 24 to line 40, while this works in a separate ilogic rule

Sub Main()
	Dim oDoc As Document = ThisDoc.Document
        
	If MessageBox.Show ( _
		"This will change all title blocks in IDW file for all of the files referenced by this document that have drawings files." _
		& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
		& vbLf & " " _
		& vbLf & "Are you sure you want to create IDW Drawings for all of the referenced documents?" _
		& vbLf & "This could take a while.", "iLogic  - Batch Output PDFs ",MessageBoxButtons.YesNo) = vbNo Then
		Exit Sub
	End If
	
    '- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
	Dim oDrawDoc As DrawingDocument
	Dim oNoDwgString, idwPathName As String
    For Each oRefDoc As Document In oDoc.AllReferencedDocuments
        oBaseName = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.FullFileName)
        oPathAndName = System.IO.Path.GetDirectoryName(oRefDoc.FullFileName) & "\" & oBaseName
        If (System.IO.File.Exists(oPathAndName & ".idw")) Then
			oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".idw", True)
			'save copy of it to other directory
			
					Dim doc As DrawingDocument = ThisDoc.Document
					Dim templateFileName As String = "D:\data\Autodesk - Morren\3. Inventor templates\Morrenbv.idw"
					Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)

				' copy your titleblock to original drawing
				Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("GL bv")
				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

			'oDrawDoc.SaveAs(oFolder & oBaseName & ".idw", True)
            oDrawDoc.Close
			oDrawDoc = Nothing
        Else
			idwPathName = oRefDoc.FullFileName
            oNoDwgString = oNoDwgString & vbLf & idwPathName
        End If
    Next
    
    
    MessageBox.Show("Title blocks are changed")
    MsgBox("Files found without drawings: " & vbLf & oNoDwgString)
End Sub

[CCarreiras]

Hi!

Autodesk has a tool do to that, why d'ont you use it?

[morrenengineering]

Then I have only the information in the file, not the replacement of the title block in the drawing

[CCarreiras]

This tool is exactly for changing the title block (among other options, borders etc) based on a newly designed title block, including all property fields, and this can be done in a batch by selecting all the files you want change at the same time.

[morrenengineering]

I do not want to change the title block, I want to replace the title block

[WCrihfield]

Hi @morrenengineering.

Within your code, try getting rid of this line of code:

Dim doc As DrawingDocument = ThisDoc.Document

...because you already have a reverence to the drawing document (oDrawDoc).

Then find/replace all following uses of the 'doc' variable with 'oDrawDoc' instead.

Change:

Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(doc, True)

to

Dim newTitleBlok As TitleBlockDefinition = templateTitleBloc.CopyTo(oDrawDoc, True)

Change:

For Each sheet As Sheet In doc.Sheets

to

For Each sheet As Sheet In oDrawDoc.Sheets

...and un-comment out your SaveAs line, because it is already using the oDrawDoc variable.

Just my thoughts based on what I see.

[JelteDeJong · Accepted solution]

I think that you can use the method that @CCarreiras proposes but you will need to select the files your self 😉 But if you want to do it a bit more automated way...

I did have a look at your rule. (I could not test it by the way) I found some points.

The template file is opened and closed a lot. I moved those actions outside the loop.

On line 23 I found "ThisDoc.Document" I found that strange and I believe you need to use the object "oDrawDoc".

I have added some try/catch blocks so if something goes wrong you can tell us where 😉

Try this rule:

Dim oDoc As Document = ThisDoc.Document

If MessageBox.Show(
		"This will change all title blocks in IDW file for all of the files referenced by this document that have drawings files." _
		& vbLf & "This rule expects that the drawing file shares the same name and location as the component." _
		& vbLf & " " _
		& vbLf & "Are you sure you want to create IDW Drawings for all of the referenced documents?" _
		& vbLf & "This could take a while.", "iLogic  - Batch Output PDFs ", MessageBoxButtons.YesNo) = vbNo Then
    Exit Sub
End If

Dim templateFileName As String = "D:\data\Autodesk - Morren\3. Inventor templates\Morrenbv.idw"
Dim templateDoc As DrawingDocument = ThisApplication.Documents.Open(templateFileName, False)
Dim templateTitleBloc As TitleBlockDefinition = templateDoc.TitleBlockDefinitions.Item("GL bv")

'- - - - - - - - - - - - -Component Drawings - - - - - - - - - - - -
Dim oDrawDoc As DrawingDocument
Dim newTitleBlok As TitleBlockDefinition
Dim oNoDwgString, idwPathName As String
For Each oRefDoc As Document In oDoc.AllReferencedDocuments
    Dim oBaseName = System.IO.Path.GetFileNameWithoutExtension(oRefDoc.FullFileName)
    Dim oPathAndName = System.IO.Path.GetDirectoryName(oRefDoc.FullFileName) & "\" & oBaseName
    If (System.IO.File.Exists(oPathAndName & ".idw")) Then

        Try
            oDrawDoc = ThisApplication.Documents.Open(oPathAndName & ".idw", True)
            newTitleBlok = templateTitleBloc.CopyTo(oDrawDoc, True)
        Catch ex As Exception
            MsgBox("Something went wrong while copy TitleBlockDefinition to file: " & oDrawDoc.FullFileName)
        End Try

        For Each sheet As Sheet In oDrawDoc.Sheets
            Try
                Dim oldTitleblock As TitleBlock = Sheet.TitleBlock
                If (oldTitleblock IsNot Nothing) Then
                    oldTitleblock.Delete()
                End If
                Sheet.AddTitleBlock(newTitleBlok)
            Catch ex As Exception
                MsgBox(String.Format("something went wrong on sheet '{0}' in file '{1}'",
                                     Sheet.Name, oDrawDoc.FullFileName))
            End Try
        Next

        oDrawDoc.Close()
        oDrawDoc = Nothing
    Else
        idwPathName = oRefDoc.FullFileName
        oNoDwgString = oNoDwgString & vbLf & idwPathName
    End If
Next

templateDoc.Close(True)

MessageBox.Show("Title blocks are changed")
MsgBox("Files found without drawings: " & vbLf & oNoDwgString)