Have the sheet name automatically generate in Title block

[BrandonLee_Innovex]

I am trying to have my title block sheet name automatically populated once the sheet name has been set. 

For example, the image i have attached shows the sheet names we type in, 

but our current process requires us to type in the sheet name multiple times to appear both in the sidebar shown as well as the title block.

I am wondering if there is a way to make the title block auto-populate once the sheet name has been filled out in the sidebar. 

[JelteDeJong]

you can try this.

Dim doc As DrawingDocument = ThisDoc.Document
Dim sheet As Sheet = doc.ActiveSheet
Dim titleBlock As TitleBlock = sheet.TitleBlock

Dim textBox As Inventor.TextBox = titleBlock.Definition.Sketch.TextBoxes.
        Cast(Of Inventor.TextBox).
        Where(Function(tb) tb.FormattedText.Contains("<Prompt")).
        Where(Function(tb) tb.FormattedText.Contains("SHEET DESCRIPTION")).
        FirstOrDefault()
If (textBox Is Nothing) Then Throw New Exception("Promted entry not found.")
titleBlock.SetPromptResultText(textBox, sheet.Name)

[BrandonLee_Innovex]

Is there a way to update the code to remove the :1, :2 at the end 

[JelteDeJong]

here is an updated rule:

Dim doc As DrawingDocument = ThisDoc.Document
Dim sheet As Sheet = doc.ActiveSheet
Dim titleBlock As TitleBlock = sheet.TitleBlock

Dim textBox As Inventor.TextBox = titleBlock.Definition.Sketch.TextBoxes.
        Cast(Of Inventor.TextBox).
        Where(Function(tb) tb.FormattedText.Contains("<Prompt")).
        Where(Function(tb) tb.FormattedText.Contains("SHEET DESCRIPTION")).
        FirstOrDefault()
If (textBox Is Nothing) Then Throw New Exception("Promted entry not found.")

Dim sheetDescription = sheet.Name
Dim puntPlace = InStr(sheetDescription, ":") - 1
sheetDescription = sheetDescription.Substring(0, puntPlace)
titleBlock.SetPromptResultText(textBox, sheetDescription)

[BrandonLee_Innovex]

Thank you for the help on this, one last thing, the code has to be run on each sheet. Is there a way to have to automatically run on each sheet in the drawing. 

[JelteDeJong · Accepted solution]

try this:

Dim doc As DrawingDocument = ThisDoc.Document
For Each sheet As Sheet In doc.Sheets
    Dim titleBlock As TitleBlock = Sheet.TitleBlock

    Dim textBox As Inventor.TextBox = titleBlock.Definition.Sketch.TextBoxes.
	    Cast(Of Inventor.TextBox).
	    Where(Function(tb) tb.FormattedText.Contains("<Prompt")).
	    Where(Function(tb) tb.FormattedText.Contains("SHEET DESCRIPTION")).
	    FirstOrDefault()
    If (textBox Is Nothing) Then 
		MsgBox("Promted entry not found on sheet: " & Sheet.Name)
		continue for
	End If

    Dim sheetDescription = Sheet.Name
    Dim puntPlace = InStr(sheetDescription, ":") - 1
    sheetDescription = sheetDescription.Substring(0, puntPlace)
    titleBlock.SetPromptResultText(textBox, sheetDescription)
Next

[BrandonLee_Innovex]

Instead of having the code reference a prompted entry. How would you adjust this to referencing iproperty vaule "SHEET DESCRIPTION" 

[j.oudalstoel]

JelteDeJong

Just wanted to say thank you for providing this code. It solved an issue I was having with getting my title block to reflect the sheet name. 

[shaight]

Thank you for providing this @JelteDeJong! I was trying to have AI write me something similar but wasn't getting the results I wanted. After using the code you provided, I was getting an error because of some sheets that we have as Excluded from Count. I ran your code through an AI chat and got the below to adjust that for me. If anyone else uses Exclude from Count on certain sheets, feel free to use this. (our prompted entry is SHEET TITLE, instead of SHEET DESCRIPTION, so that is changed in the below).

Exclude from Count error:

Length cannot be less than zero.
Parameter name: length

Dim doc As DrawingDocument = ThisDoc.Document
For Each sheet As Sheet In doc.Sheets
    Dim titleBlock As TitleBlock = Sheet.TitleBlock

    ' Find the textbox within the title block's sketch that contains the prompt markers
    Dim textBox As Inventor.TextBox = titleBlock.Definition.Sketch.TextBoxes _
        .Cast(Of Inventor.TextBox)() _
        .Where(Function(tb) tb.FormattedText.Contains("<Prompt") AndAlso tb.FormattedText.Contains("SHEET TITLE")) _
        .FirstOrDefault()

    If (textBox Is Nothing) Then
        MsgBox("Prompted entry not found on sheet: " & Sheet.Name)
        Continue For
    End If

    ' Extract the sheet description; here, trimming after colon
    Dim sheetDescription As String = Sheet.Name
    Dim puntPlace As Integer = InStr(sheetDescription, ":")
    If puntPlace > 0 Then
        sheetDescription = sheetDescription.Substring(0, puntPlace - 1)
    End If

    ' Set the prompt result text in the title block
    titleBlock.SetPromptResultText(textBox, sheetDescription)
Next