Replacing titleblocks, Code will only replace 1st and last page

[Anonymous]

I have put together some code from some pieces online. It is working well with one exception. It will only replace the 1st and last page titleblocks.

A little background. With our drawings we have a titleblock for page 1 and then we have a titleblock for page 2 and on. The code is replacing the 1st page with the correct (1st) page titleblock and the the last page with the correct (page2) titleblock. The titleblocks in the middle however are getting page 1 titleblocks. Any suggestions would be greatly appreciated. I am very new with iLogic so be gentile:-)

    Dim oDrawingDoc As Inventor.DrawingDocument
    Dim oSheetNumber As Integer
    Dim oActiveSheetNumber As Integer
    Dim oActiveSheetName As String    
    Dim oSheet As Sheet
    Dim oSourceTitleBlockDef As TitleBlockDefinition
    Dim oNewTitleBlockDef As TitleBlockDefinition

    oDrawingDoc = ThisApplication.ActiveDocument

    oActiveSheetName = ActiveSheet.Name

    oSheet = oDrawingDoc.ActiveSheet
    
    If (oSheet.TitleBlock.Name = "page1titleblock") Then
        oTitleBlockName = "page1titleblock"
    ElseIf (oSheet.TitleBlock.Name = "page2titleblock") Then
        oTitleBlockName = "page2titleblock"
     Else:
    End If

For oSheetNumber = 1 To oDrawingDoc.Sheets.Count
        oDrawingDoc.Sheets(oSheetNumber).Activate
        If Not oDrawingDoc.ActiveSheet.TitleBlock Is Nothing Then
            oDrawingDoc.ActiveSheet.TitleBlock.Delete
        End If
    Next oSheetNumber

    Dim oTitle As TitleBlockDefinition
    Dim oTitleBlock As TitleBlock
    
    For Each oTitle In oDrawingDoc.TitleBlockDefinitions
        If oTitle.IsReferenced = False Then
        oTitle.Delete
        End If
        Next
        
ThisDrawing.ResourceFileName = "path\to\Template\template.DWG"
ThisDrawing.KeepExtraResources = True

ActiveSheet.TitleBlock = "page1titleblock"
ActiveSheet.TitleBlock = "page2titleblock"

    oSheetNumber = 1
        oDrawingDoc.Sheets(oSheetNumber).Activate
        ActiveSheet.TitleBlock = oTitleBlockName

    oSheetNumber = 2 
        oDrawingDoc.Sheets(oSheetNumber).Activate
        ActiveSheet.TitleBlock = oTitleBlockName

[NachoShaw · Accepted solution]

Hi

i havent read your code but you will need to itterate through the sheets and replace the titleblock independently. i have made a tool that does this and im in the process of making it into an addin. I will post a video very shortly for you see if it what you are trying to achieve

Thanks

Nigel

[NachoShaw]

Hi

See video attached

Thanks

[GosponZ · Accepted solution]

Here is code i'm using to change TB in multi sheets .Make parameter for Border. Insert empty sheet with new TB and run rule . Delete empty sheet

I'm sure there is better way but this one working just fine.

For Each sheetX As Sheet In ThisDrawing.Document.Sheets

ThisDrawing.Sheet(sheetX.Name).TitleBlock = "Your TB"

iLogicVb.UpdateWhenDone = True

ThisApplication.ActiveView.Fit

Next

If Parameter("Border") = "Border" Then

ActiveSheet.Border = "Border"

End If

iLogicVb.UpdateWhenDone = True

[Anonymous]

Thanks to all for your help and suggestions. The code is working:-)

[adam.nagy]

Hi Molly,

Could you please mark the answer that helped as solution? 🙂

I think it's possible to mark multiple comments like that if you wish.

Cheers,

[GosponZ]

I can't see that option

[adam.nagy]

Hi,

Tha author of a thread can click "ACCEPT AS SOLUTION" on any comment made.

I also think this can be done on multiple comments of the same thread (if someone wants to) - I'm pretty sure I've seen a thread where multiple comments were greened out. 🙂

Cheers,

[GosponZ]

Hi Adam,
maybe Molly can. I do not see ,not in option drop menu, or button for accepting solution.