HI!
Have you found a solution to that yet? I'd like to do the same. Please, let me know if you got success.
Thanks!
Roger
You would need to either make a addin to automatically set the value on open or save or some event. I know Brian made a addin that would run a macro automatically on some events... not sure if it is in the SDK folder or ??
Anyhow, there may be a easier way to get to the prompted text, but if you add a prompted text to your titleblock this should do it. If the prompted text wasn't the last thing added to the titleblock, you may have to change the one line commented below. As I said, there is probably a easier way to get to a specific prompted entry, but I haven't worked with them enough, and this was quick and dirty.
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSheets As Sheets
Set oSheets = oDoc.Sheets
Dim oSheet As Sheet
Dim oTblock As TitleBlock
Dim oTbox As TextBox
For Each oSheet In oSheets
Set oTblock = oSheet.TitleBlock
' you will need to possibly change the value in this line to where your prompted text is in the titleblock
Set oTbox = oTblock.Definition.Sketch.TextBoxes(oTblock.Definition.Sketch.TextBoxes.Count)
Call oTblock.SetPromptResultText(oTbox, oSheet.Name)
Next
Hello
In addition to Kent's Code you could give the prompted text a name like "SheetName". Then you could use the following code to get exakt the right textox, not only the last. Maybe this is better for further changes nad additions to your titleblock.
Private Sub SheetName()
Dim oDoc As DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oTitleBlock As TitleBlock
Dim oTextBox As TextBox
Dim oSheet As Sheet
For Each oSheet In oDoc.Sheets
Set oTitleBlock = oSheet.TitleBlock
For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes
If oTextBox.Text = "SheetName" Then
Call oTitleBlock.SetPromptResultText(oTextBox, oSheet.Name)
End If
Next
Next
End Sub
Thank you Kent and Krieg,
I'll try your suggestions and I'll post the results.
Roger
It's been quite a while since my last post here.
I've been trying to improve my title block again and implemented your code. I've made a small change, it's working like this:
DimoDocAsDrawingDocument
oDoc=ThisApplication.ActiveDocument
DimoTitleBlockAsTitleBlock
DimoTextBoxAsTextBox
DimoSheetAsSheet
ForEachoSheetInoDoc.Sheets
oTitleBlock=oSheet.TitleBlock
ForEachoTextBoxInoTitleBlock.Definition.Sketch.TextBoxes
IfoTextBox.Text="Sub-título"Then
CalloTitleBlock.SetPromptResultText(oTextBox, oSheet.Name)
EndIf
Next
Nex
The only problem with that it's showing ":1", ":2", at the end of the sheet name.
For example, my sheet name is "Main Assembly". In the browser it shows: "Main Assembly:1"
What do I have to do in order to my title block shows only the name, without the ":1", ":2", and so on?
Thanks.
Roger
PS. I've managed to make the firstscale to work inside the title block for every drawing sheet in the same idw.
It's working like a charm.
Hi
So try to cut the last 2 Chars:
CalloTitleBlock.SetPromptResultText(oTextBox, left(oSheet.Name,len(oSheet.Name)-2))
or get the position of the ":" and cut all after it
Dim lPos As Long Dim sSheetName As String lPos = InStr(oSheet.Name, ":") sSheetName = Left(oSheet.Name, lPos - 1) Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName)
Yooohoooo!!!
It worked.
Thank's for the lightning fast reply.
The code is now like this:
Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oTitleBlock As TitleBlock Dim oTextBox As TextBox Dim oSheet As Sheet Dim lPos As Long Dim sSheetName As String For Each oSheet In oDoc.Sheets oTitleBlock = oSheet.TitleBlock lPos = InStr(oSheet.Name, ":") sSheetName = Left(oSheet.Name, lPos - 1) For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes If oTextBox.Text = "Sub-título" Then Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName) End If Next Next
I did some tests and it's working great.
Thank you very much.
Roger.
Hi
There is a theoretical error possible, if your sheetname includes a second ":". Don't know, if a ":" is allowed in sheetnames. Then you will get only a part of your sheetname. So please change your code.
Dim lPos As Long Dim sSheetName As String lPos = InStr(StrReverse(oSheet.Name), ":") sSheetName = StrReverse(Right(oSheet.Name, lPos + 1)) Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName)
I'm am following the discussion and i've tried to impletate it in my template bus is does't work.
Can someone please tell by step what i have to do!?
What i've done is put the text as a rul in iLogic and then i'm stuck.
cheers
Rick
I am finding a need to have this in 2017.. thankful someone has started the conversation already.
We have a customer that uses an old stodgy system and I am working to leverage as much automated line filling as possible in an Inventor border and still fulfill the company/client required data. Using the sheet name as the second descriptor line in the title block will be a huge win for me as I also on occasion need to export all sheets as AutoCAD .dwg files.. yep they autoname by the sheet name! That is how I guessed there might be a background bit of code that could used for this!
Hello
Add a prompted text for your second descriptor in your title block and name it "title_line_2". Copy the following Code to a iLogic rule and name the rule e.g. title_line_2. Save the rule and close the dialog. Add an iLogic Event at preSave of the Document.
On every save of the document all sheetnames will be written in the prompted text of each title block.
Sub Main() Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oTitleBlock As TitleBlock Dim oTextBox As TextBox Dim oSheet As Sheet Dim lPos As Long Dim sSheetName As String For Each oSheet In oDoc.Sheets oTitleBlock = oSheet.TitleBlock lPos = InStr(oSheet.Name, ":") sSheetName = Left(oSheet.Name, lPos - 1) For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes If oTextBox.Text = "title_line_2" Then Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName) End If Next Next End Sub
That was really fast!
OK. I am not an expert in iLogic at all so I may be doing something completely wrong but I am getting this message when I attempt to 'Save and Run' the new rule.
"Error in rule: title_line_2, in document: FEL TEMPLATE TEST.idw
Argument 'Length' must be greater to or equal to zero."
Any idea what I am doing wrong?
Thanks again!!!
Hello
This error occurs if the sheet name is empty or there is no ":" in sheet name. Normally both is not possible. *???*
I've added a check to avoid this error. Can you test it please?
Sub Main() Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oTitleBlock As TitleBlock Dim oTextBox As TextBox Dim oSheet As Sheet Dim lPos As Long Dim sSheetName As String For Each oSheet In oDoc.Sheets oTitleBlock = oSheet.TitleBlock lPos = InStr(oSheet.Name, ":") If lPos > 0 Then sSheetName = Left(oSheet.Name, lPos - 1) Else sSheetName = oSheet.Name End If For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes If oTextBox.Text = "title_line_2" Then Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName) End If Next Next End Sub
OK..no change. Maybe I am doing something wrong. I changed the prompted entry from <title_line_2> to <"title_line_2"> should I be removing the <> brackets?
Like I said I am not an expert at iLogic!
If I don't reply its because I am leaving on holidays for a week. I will get back to you as quickly as I can however!
OK..I stated that wrong..there was a change..I no longer get the error code!
It is not however working either direction. I add a sheet I get prompt to rename title line 2 but that is all. If I change it in the browser it doesn't change in the title block when I save and if I change the name in prompted entry it does not change it in the browser..
This is the code I've been using for many years now and works perfectly:
Dim oDoc As DrawingDocument oDoc = ThisApplication.ActiveDocument Dim oTitleBlock As TitleBlock Dim oTextBox As TextBox Dim oSheet As Sheet Dim lPos As Long Dim sSheetName As String For Each oSheet In oDoc.Sheets If oSheet.ExcludeFromCount = False Then oTitleBlock = oSheet.TitleBlock lPos = InStr(oSheet.Name, ":") sSheetName = Left(oSheet.Name, lPos - 1) For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes If oTextBox.Text = "Sheet Name" Then Call oTitleBlock.SetPromptResultText(oTextBox, sSheetName) End If Next Else End If Next
Umm....trigger?
I am new to this and didn't see anything about it in the above... not sure how to do that if it wasn't in the code..that is the window I see the Parameter iTrigger0 here ...but nothing in those columns when I check the title block...maybe this is what I am not doing?