Replace Title block, borders and sheet format

[dypro]

Hello everyone, 
here is a tricky one. 
I have a lot of old drawings (inventor dwgs) with an outdated border and sheet format, need to replace those with new ones from a template. This is a code I found to do it  (the problem is not in the code, it is at the bottom):

Option Explicit on

Sub Main()

If ThisApplication.ActiveDocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
	MessageBox.Show("This rule only works for Drawing Documents.", "Wrong Document Type", MessageBoxButtons.OK, MessageBoxIcon.Warning, MessageBoxDefaultButton.Button1)
	Exit Sub
End If

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oBorder As Border = oSheet.Border

'Query Drawing Border insertion requirement
Dim question As DialogResult = MessageBox.Show("Do you want to replace the existing drawing border with a new drawing border?" _
& vbLf & "THIS CANNOT BE UNDONE!", "Border Requirement", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If question = vbYes Then
	DeleteBorders
	InsertBorder
	DeleteRevTable
	ActivateSheetOne
End If

End Sub


Sub DeleteBorders() 'this code deletes all the drawing sheet borders inthe active idw
'MessageBox.Show("deleteborder sub", "Title")
Logger.Info("running delete borders")
Dim oDrawDoc1 As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet1 As Sheet = oDrawDoc1.ActiveSheet

' Check to see if the sheet already has a border and delete it if it does.
For Each oSheet1 In ThisApplication.ActiveDocument.Sheets
	If Not oSheet1.Border Is Nothing Then
        oSheet1.Border.Delete
    End If
Next
Logger.Info("finished running delete borders")
End Sub


Sub InsertBorder() ' this code inserts a user selected drawing border on all drawing sheets in the active idw
'MessageBox.Show("insertborder sub", "Title")

'user slects a drawing border to insert
	Dim oDrawDoc3 As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet3 As Sheet = oDrawDoc3.ActiveSheet
	Dim borderDef As BorderDefinition
	Dim strSelectedBorder As String = "Result2"
	Dim strBorderList As New ArrayList
	
	Dim strBorderRequired As Boolean = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	' change this file name & location to use a different 	
	ThisDrawing.ResourceFileName = "C:\Users\Public\VAULT\Inventor Libraries\Templates\222040-A (DIN A1).dwg"
	Dim SourceFile = ThisDrawing.ResourceFileName
                    
    Dim strSourceIDW As DrawingDocument
    strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)

	For Each borderDef In strSourceIDW.BorderDefinitions
        strBorderList.Add(borderDef.Name)
    Next
			
	strSelectedBorder = InputListBox("Please select a border.", strBorderList, strSelectedBorder, "Border Selection", "Available Borders")
	If strSelectedBorder = "Default Border" Then
		MessageBox.Show("Changing the Default Border border is NOT ALLOWED, exiting")
		Logger.Error("User attempted to delete Default Border; this is not allowed by the API!")
		Exit Sub
	End If
	
	Dim NewBorder As BorderDefinition
	For Each borderDef In strSourceIDW.BorderDefinitions
        If (borderDef.Name = strSelectedBorder) Then
            NewBorder = borderDef.CopyTo(strDrawDoc, True)
			Exit For
       	End If
	Next
	
	strSourceIDW.Close()
	
	Dim oNewBorderDef As BorderDefinition
	oNewBorderDef = oDrawDoc3.BorderDefinitions.Item(NewBorder.Name)

	For Each oSheet3 In oDrawDoc3.Sheets
			oSheet3.AddBorder(oNewBorderDef)
	Next

End Sub


Sub DeleteRevTable() 'this code deletes the current rev table from the idw
'MessageBox.Show("rev table sub", "Title")

Dim oDrawDoc2 As Inventor.DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet2 As Sheet = oDrawDoc2.ActiveSheet

Dim oDoc As Document = ThisDoc.Document
For Each oSheet2 In oDoc.Sheets
	If oSheet2.RevisionTables.Count>0 Then
		For Each oRevTable As RevisionTable In oSheet2.RevisionTables
			oRevTable.Delete
		Next
	End If
Next

End Sub

Sub ActivateSheetOne() 'makes drawing sheet 1 active in the idw
'MessageBox.Show("activesheet1 sub", "Title")
ActiveSheet = ThisDrawing.Sheet("Sheet:1")
End Sub

Dim doc As DrawingDocument = ThisDoc.Document
Dim templateFileName As String = "C:\Users\Public\VAULT\Inventor Libraries\Templates\222040-A (DIN A1).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 

But here's the problem, some time ago, out title block was an AUTOCAD BLOCK WITH ATRIBUTES.
I need to combine the change of sheet format, and the change of borders with something that saves the atributes  from that block (there are like 25 of them) into some custom iproperties of the drawing (also like 25 obviously), witch in some cases will be already created, and in some others won't, then deletes the old titleblock (autocad block that could be named "SH_CAR_S" or "Copia de SH_CAR_S") if exists, deletes another autocad block named "MARCO2000" if exists, and finally takes the new titleblock (that is actually an inventor titleblock that is in the template)

[bradeneuropeArthur]

There is a tool for from Autodesk selves called "Drawing Resource Transfer Wizard 20##" found under C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Autodesk Inventor 20##\Tools..

[dypro]

Hello, thanks for the answer.

Well, I have tryed the tool, it does.... nothing of what I wanted other than copy paste the title block and the sheet format and borders.

I mean, if all I wanted was to get the new stuff in the drawing it's.... ok? but it does not put it in the sheet, nor does erase the old ones.

On top of that, that doesn't do anything with the most tedious thing, copy the atributes from the autocad block to personalized iproperties that probably have to be created, so.... It's kind of useless to me.

[dypro]

Help pls?

[bradeneuropeArthur]

If the new items have the same name as the old items than it should work correct.

[dypro]

The new ones are named diferent, but that's not the main problem.

As i said, some time ago, out title block was an AUTOCAD BLOCK WITH ATRIBUTES.
I need to combine the change of sheet format, and the change of borders with something that saves the atributes  from that block (there are like 25 of them) into some custom iproperties of the drawing (also like 25 obviously), witch in some cases will be already created, and in some others won't, then deletes the old titleblock (autocad block that could be named "SH_CAR_S" or "Copia de SH_CAR_S") if exists, deletes another autocad block named "MARCO2000" if exists, and finally takes the new titleblock (that is actually an inventor titleblock that is in the template)