Not easy or too clean but I generated a tool to do just that for my group... feel free to cut whatever you want from this. Note, I have a code module that pulls metadata from the model into the drawing, you can probably ignore that section.
'Update title block(s) and add updated code modules - ebuckner - 05/19/11
Public Sub TitleBlockUpdater()
'Set Active Application
Dim oApp As Application
Set oApp = ThisApplication
'Get the active document and make sure it's a drawing.
Dim oTDoc As Document
Set oTDoc = ThisApplication.ActiveDocument
If oTDoc.DocumentType <> kDrawingDocumentObject And oTDoc.DocumentSubType.DocumentSubTypeID <> "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then
MsgBox "Must be in Drawing Document to run the Title Block Update Tool! "
Exit Sub
End If
'Check for and Remedy Deferred Updates
If oTDoc.DrawingSettings.DeferUpdates = True Then
RemoveDeferralForm.Show
End If
'Check for Remedied Deferred Updates
If oTDoc.DrawingSettings.DeferUpdates = True Then
MsgBox "Updates are Deferred, Exiting Command."
Exit Sub
End If
'Get Application Software Version
Dim oSoftVersion As Long
oSoftVersion = oApp.SoftwareVersion.Major
'Get Drawing Version Saved As
Dim oDocVersion As Long
oDocVersion = oTDoc.SoftwareVersionSaved.Major
'Check for and remedy Migration status
If oDocVersion <> oSoftVersion Then
MigrateDrawing.Show
End If
'Get the default VBA project.
Dim oVBAProjects As InventorVBAProjects
Set oVBAProjects = ThisApplication.VBAProjects
'Record Original Project Name
Dim sTargetOrig As String
sTargetOrig = oTDoc.VBAProject.Name
'Set Project Name to Target
Dim oTargetVBA As String
oTargetVBA = "TargetProject"
oTDoc.VBAProject.Name = oTargetVBA
'Define the project name ".ivb"
Dim sProjectName As String
sProjectName = oTargetVBA
'Count Projects
Dim iNumberOfProject As Integer
iNumberOfProject = oVBAProjects.Count
'Ensure more than one Project
If iNumberOfProject > 0 Then
'Create List
Dim j As Integer
For j = 1 To oVBAProjects.Count
'Create List
Dim oVBAProject As InventorVBAProject
Set oVBAProject = ThisApplication.VBAProjects.Item(j)
'Define Name
Dim sVBAProjectName As String
sVBAProjectName = oVBAProject.Name
'Compare j to Target Name
If sVBAProjectName = sProjectName Then
GoTo PLACE
End If
Next j
End If
'Get the associated VBE project. This is a Microsoft object
'defined in the Visual Basic Extensibility library.
PLACE:
Dim oVBProject As Object
Set oVBProject = oVBAProject.VBProject
On Error Resume Next
Debug.Print oVBProject.VBComponents("AutoPropsFromModel").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("AutoPropsFromModel")
On Error Resume Next
Debug.Print oVBProject.VBComponents("APFM").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("APFM")
On Error Resume Next
Debug.Print oVBProject.VBComponents("AutoScale").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("AutoScale")
On Error Resume Next
Debug.Print oVBProject.VBComponents("UpdateCode").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("UpdateCode")
On Error Resume Next
Debug.Print oVBProject.VBComponents("UpdateCode1").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("UpdateCode1")
On Error Resume Next
Debug.Print oVBProject.VBComponents("UpdateCode2").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("UpdateCode2")
On Error Resume Next
Debug.Print oVBProject.VBComponents("AddMassCustProps").Name
oVBProject.VBComponents.Remove oVBProject.VBComponents("AddMassCustProps")
'Insert the updated code modules
oVBProject.VBComponents.Import ("J:\Shared\Library\Inventor\ZZCode-2010\APFM.bas")
oVBProject.VBComponents.Import ("J:\Shared\Library\Inventor\ZZCode-2010\AutoScale.bas")
'Reset Project Name to Orig
oTDoc.VBAProject.Name = sTargetOrig
'Save the names of the title block definition used for each sheet
'and delete the title blocks.
Dim colDefNames As New Collection
Dim oTargetSheet As Sheet
For Each oTargetSheet In oTDoc.Sheets
'Activate the sheet.
oTargetSheet.Activate
'Save the name of the title block definition used for this sheet.
colDefNames.Add oTDoc.ActiveSheet.TitleBlock.Definition.Name
'Delete the title block.
oTargetSheet.TitleBlock.Delete
Next
'Copy the new definitions from the source into the target document.
oTDoc.Activate
Dim oSourceDoc As Inventor.DrawingDocument
Set oSourceDoc = ThisApplication.Documents.Open("C:\Vault\#Templates\IDW-Standard.idw")
Dim oSourceTB As TitleBlockDefinitions
Set oSourceTB = oSourceDoc.TitleBlockDefinitions
Dim oSourceSS As SketchedSymbolDefinitions
Set oSourceSS = oSourceDoc.SketchedSymbolDefinitions
Call oSourceTB.Item("ENTEK - A").CopyTo(oTDoc, True)
Call oSourceTB.Item("ENTEK - B").CopyTo(oTDoc, True)
Call oSourceTB.Item("ENTEK - C").CopyTo(oTDoc, True)
Call oSourceTB.Item("ENTEK - D").CopyTo(oTDoc, True)
Call oSourceTB.Item("ENTEK - E").CopyTo(oTDoc, True)
Call oSourceSS.Item("Revision Block").CopyTo(oTDoc, True)
Call oSourceSS.Item("Mass Adder").CopyTo(oTDoc, True)
'Add the title blocks to the sheets.
Dim i As Integer
For Each oTargetSheet In oTDoc.Sheets
'Activate the sheet.
oTargetSheet.Activate
'Add the title block.
i = i + 1
Call oTargetSheet.AddTitleBlock(oTDoc.TitleBlockDefinitions.Item(colDefNames.Item(i)))
Next
'Add any iProperties.
On Error Resume Next
Dim oCustomSet As PropertySet
Set oCustomSet = oTDoc.PropertySets.Item("Inventor User Defined Properties")
Call oCustomSet.Add("NIL", "FirstViewScale")
On Error GoTo 0
'Clean up.
oSourceDoc.Close
Set oTDoc = Nothing
Set oTargetSheet = Nothing
Set oSourceDoc = Nothing
Set oSourceTB = Nothing
Set oCustomSet = Nothing
Set oProp = Nothing
Set oVBAProjects = Nothing
Set oVBAProject = Nothing
Set oVBProject = Nothing
Set oVBModule = Nothing
End Sub
