list titleblocks in idw

[Anonymous]

Gents,

from time to time we have to implement client templates on our drawings. I have a piece of code that when run will swap out a title block from one idw to another. This works well as it allows us to fill up the client template idw with lots of title blocks for various clients  and we keep our regular standard.idw relatively lightweight in file size. Only running the code when needed.

However, every time I have to add a new title block to the template; I have to modify the code to give and add a reference to the new title block so that the user has an option to pick the required title block from a list.

What I would like to do is that the code just checks the whole template drawing for ALL titleblocks and then displays these in a list box for the user to select from. This allows for the code to automatically update with no further revisions.

code below if anyone can help

Thanks in advance

Format:HTML Format Version:1.0 StartHTML: 165 EndHTML: 17470 StartFragment: 314 EndFragment: 17438 StartSelection: 314 EndSelection: 314SyntaxEditor Code Snippet

Sub Main()

If ThisApplication.ActiveDocument Is Nothing Or ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then    MsgBox ("Please open a Drawing to work on.")    Exit Sub

End If

'reference template location
ThisDrawing.ResourceFileName = "C:\Work\Inventor\Templates\Client template.idw"
ThisDrawing.KeepExtraResources = False

Dim oDrawingDoc As Inventor.DrawingDocument: oDrawingDoc = ThisApplication.ActiveDocument
Dim SheetNumber As Integer

'Clear out the old Titleblocks & Sheetformats
For SheetNumber = 1 To oDrawingDoc.Sheets.Count    oDrawingDoc.Sheets(SheetNumber).Activate    If Not oDrawingDoc.ActiveSheet.TitleBlock Is Nothing Then        oDrawingDoc.ActiveSheet.TitleBlock.Delete    End If
Next SheetNumber

'Delete the previous title blocks as the API does not support replacing Sheet Formats.'DeleteSheetFormatsAll (oDrawingDoc)'DeleteBorders (oDrawingDoc)
DeleteTitleBlocks (oDrawingDoc)

Dim resu1t As String="Result"
Dim T1TLE As New ArrayList
T1TLE.Add("GSH")
T1TLE.Add("ACME")

resu1t=InputListBox("Select Client Title Block", T1TLE, resu1t, _
Title := "My Company Name", ListName := "Title Blocks available from Template;")
    'Set iProperties based On the selection.
    If resu1t="GSH" Then    ActiveSheet.TitleBlock = "GSH"
'    'End If
    ElseIf resu1t="ACME" Then    ActiveSheet.TitleBlock = "ACME"
'    'End If

End If


End Sub

Sub DeleteTitleBlocks(oActiveDoc As Inventor.DrawingDocument)
'Iterate through the collection deleting any titleblocks that are not referenced by the drawing object
Dim oTitle As TitleBlockDefinition    For Each oTitle In oActiveDoc.TitleBlockDefinitions        If oTitle.IsReferenced = False Then        oTitle.Delete        End If    Next
End Sub