Change Title block and Border

[r_hoekstra]

Is there a way to get titleblocks and borders from the drawings resources in a drawing ?

I found how to change the titleblocks or border but then you had to give the names. I want to get a list of titleblocks and borders which are in the drawing so i can select the desired titleblock and border for the drawing in a userform..

[yuzeaa]

Title block：

Dim drawingdoc As DrawingDocument = ThisDoc.Document
Dim osheet As Sheet = drawingdoc.ActiveSheet
Dim TitleBlocks As New List(Of String)
For Each t In drawingdoc.TitleBlockDefinitions
	TitleBlocks.Add(t.Name)
Next
SelectedName = InputListBox("Select TitleBlock", TitleBlocks, "", Title := "TitleBlockDefinitions", ListName := "List")
If SelectedName Is Nothing Then Return
TitleBlockDef = drawingdoc.TitleBlockDefinitions(SelectedName)
Try:osheet.TitleBlock.Delete : Catch: End Try
osheet.AddTitleBlock(TitleBlockDef)

Border：

Dim drawingdoc As DrawingDocument = ThisDoc.Document
Dim osheet As Sheet = drawingdoc.ActiveSheet
Dim Borders As New List(Of String)
For Each b In drawingdoc.BorderDefinitions
	Borders.Add(b.Name)
Next
SelectedName = InputListBox("Select Border", Borders, "", Title := "BorderDefinitions", ListName := "List")
If SelectedName Is Nothing Then Return
BorderDef = drawingdoc.BorderDefinitions(SelectedName)
Try:osheet.Border.Delete : Catch: End Try
Try
osheet.AddBorder(BorderDef)
Catch
osheet.AddDefaultBorder
End Try

[r_hoekstra]

Thank you for the help.. 

For the borders it works but for the titleblock it gives an error about incorrect parameter. 

on this part 

osheet.AddTitleBlock(TitleBlockDef)

[yuzeaa]

Can you provide a photo of your drawing browser? Will selecting each titleblock result in an error?

[r_hoekstra]

Yeah every titleblock will give an error..
But i got prompted entrys in them. So that will be the problem i think..

Removed the prompted entrys, now it works.. Now try to get it working with the prompted entrys

[yuzeaa]

Yes ,that would be the problem. How many prompt entrys?

[r_hoekstra]

i got 2 prompted entrys in them at the moment.

[yuzeaa · Accepted solution]

I guess you will then ask if it can be automatically replaced?

Dim drawingdoc As DrawingDocument = ThisDoc.Document
Dim osheet As Sheet = drawingdoc.ActiveSheet
Dim TitleBlocks As New List(Of String)
For Each t In drawingdoc.TitleBlockDefinitions
	TitleBlocks.Add(t.Name)
Next
Dim oPromptstrings(1) As String
SelectedName = InputListBox("Select TitleBlock", TitleBlocks, "", Title := "TitleBlockDefinitions", ListName := "List")
If SelectedName Is Nothing Then Return
Promptstrings_1 = InputBox("First Promptstring", "Title", "")
If Promptstrings_1 = "" Then Return
Promptstrings_2 = InputBox("Second Promptstring", "Title", "")
If Promptstrings_2 = "" Then Return
oPromptstrings(0) = Promptstrings_1
oPromptstrings(1) = Promptstrings_2	
TitleBlockDef = drawingdoc.TitleBlockDefinitions(SelectedName)
Try:osheet.TitleBlock.Delete : Catch: End Try
osheet.AddTitleBlock(TitleBlockDef,,oPromptstrings)

[r_hoekstra]

Thank you.. this works really well.. 🙂

Not yet using the automatic update of the prompted entries, so i commented those lines out.