Add border of a path

Anonymous · ‎06-23-2021

Hello,

I have a problem with this code, 
I need to change the border of a drawing with a border that I have on my desktop, but it doesn't works
I will be grateful with the help

Sub Main()

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

		DeleteBorders
		InsertBorder

End Sub

Sub DeleteBorders()

Dim oDrawDoc1 As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet1 As Sheet = oDrawDoc1.ActiveSheet

For Each oSheet1 In ThisApplication.ActiveDocument.Sheets
	If Not oSheet1.Border Is Nothing Then
        oSheet1.Border.Delete
    End If
Next

End Sub

Sub InsertBorder()

	Dim oDrawDoc3 As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet3 As Sheet = oDrawDoc3.ActiveSheet
	Dim borderDef As BorderDefinition
	
	strBorderRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	ThisDrawing.ResourceFileName = "C:\Users\Desktop\Codigos\Templates\Parts.idw"
	Dim SourceFile = ThisDrawing.ResourceFileName

   	Dim strSourceIDW As DrawingDocument
    	strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)

	For Each borderDef In strSourceIDW.BorderDefinitions
        If (StrComp(borderDef.Name, vbTextCompare) = 0) Then
            CopyFrom = borderDef.CopyTo(strDrawDoc, True)
       	End If
	Next
	
	strSourceIDW.Close()

	Dim oNewBorderDef As BorderDefinition
	oNewBorderDef = oDrawDoc3.BorderDefinitions.Item(borderDef.Name)

	For Each oSheet3 In oDrawDoc3.Sheets
			oSheet3.AddBorder(oNewBorderDef)
	Next
	
	MessageBox.Show("The border was changed", "Title")

End Sub

FINET_Laurent · ‎06-23-2021

Hi,

Can you tell what line gives you an error ?

Regards,

FINET L.

If this post solved your question, please kindly mark it as "Solution"

If this post helped out in any way to solve your question, please drop a "Like"

@LinkedIn @JohnCockerill

Curtis_Waguespack · ‎06-23-2021

Hi @Anonymous

There were a couple of issues... your string compare had only one string in it... and also, I think you needed to hand the border definition name down to the InsertBorder sub, so it could know the name of the border that was deleted.

I think this example will work for you.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Sub Main()

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oBorder As Border = oSheet.Border
	If Not oSheet.Border Is Nothing Then
		oOriginalBorderDefName = oSheet.Border.Definition.Name
		Logger.Info(oOriginalBorderDefName)

		DeleteBorders()
		InsertBorder(oOriginalBorderDefName)
	End If
End Sub

Sub DeleteBorders()

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

	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If Not oSheet.Border Is Nothing Then
	        oSheet.Border.Delete			
	    End If
	Next

End Sub

Sub InsertBorder(oOriginalBorderDefName As String)

	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet As Sheet = oDrawDoc.ActiveSheet
	Dim borderDef As BorderDefinition
	
	strBorderRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	SourceFile = "C:\Users\Desktop\Codigos\Templates\Parts.idw"
	
   	Dim strSourceIDW As DrawingDocument
    	strSourceIDW = ThisApplication.Documents.Open(SourceFile, True)
	Logger.Info(strSourceIDW.FullFileName)
	
	For Each borderDef In strSourceIDW.BorderDefinitions
        If (StrComp(borderDef.Name, oOriginalBorderDefName, vbTextCompare) = 0) Then
            CopyFrom = borderDef.CopyTo(strDrawDoc, True)
       	End If
	Next	
	
	strSourceIDW.Close()
	

	Dim oNewBorderDef As BorderDefinition
	oNewBorderDef = oDrawDoc.BorderDefinitions.Item(oOriginalBorderDefName)

	For Each oSheet In oDrawDoc.Sheets
		oSheet.AddBorder(oNewBorderDef)
	Next
	
	MessageBox.Show("The border was changed", "Title")

End Sub

Anonymous · ‎06-24-2021

Thank you for your help @Curtis_Waguespack it works!

I have more question,

I tried using the same code and changing the title block, but it sends this error: Public member 'Title' on type 'Sheet' not found.

Sub Main()

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oTitleBlock As TitleBlock = oSheet.TitleBlock

	If Not oSheet.TitleBlock Is Nothing Then
		oOriginalTitleDefName = oSheet.Title.Definition.Name

		DeleteTitle()
		InsertTitleBlock(oOriginalTitleDefName)

	End If
End Sub

Sub DeleteTitle()

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

	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If Not oSheet.TitleBlock Is Nothing Then
	        oSheet.TitleBlock.Delete			
	    End If
	Next

End Sub

Sub InsertTitleBlock(oOriginalTitleDefName As String)

	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet As Sheet = oDrawDoc.ActiveSheet
	Dim TitleBlockDef As TitleBlockDefinition
	
	strTitleBlockRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	SourceFile = "C:\Users\rvaldivia\Desktop\Codigos\Templates\H+K Parts (mm).idw"
	
   	Dim strSourceIDW As DrawingDocument
    	strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)

	For Each TitleBlockDef In strSourceIDW.TitleBlockDefinitions
        If (StrComp(TitleBlockDef.Name, oOriginalTitleDefName, vbTextCompare) = 0) Then
            CopyFrom = TitleBlockDef.CopyTo(strDrawDoc, True)
       	End If
	Next	
	
	strSourceIDW.Close()

	Dim oNewTitleBlockDef As TitleBlockDefinition
		
	oNewTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item(oOriginalTitleDefName)

	For Each oSheet In oDrawDoc.Sheets
		oSheet.AddTitleBlock(oNewTitleBlockDef)
	Next

End Sub

Thank you once more for your help in this matter

Curtis_Waguespack · ‎06-24-2021

Hi @Anonymous

You were very close, just change Title to TitleBlock in this one place and then it should work.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Anonymous · ‎06-28-2021

I made the change but it seems to me the following error

The parameter is incorrect (Exception from HRESULT: 0x80070057 (E_INVALIDARG))

Do you know were is the error?
I've been researching but I don't know what's wrong

Thank you for your help!

Curtis_Waguespack · ‎06-29-2021

Hi @Anonymous

Maybe the source file can not be found or opened? Here is an example with some error checking and logger messaging that might help you determine the issue.

See this link for more on the ilogic logger:

To Create Log Statements | Inventor 2019 | Autodesk Knowledge Network

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

Sub Main()

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oTitleBlock As TitleBlock = oSheet.TitleBlock

If Not oSheet.TitleBlock Is Nothing Then
	oOriginalTitleDefName = oSheet.TitleBlock.Definition.Name

	DeleteTitle()
	InsertTitleBlock(oOriginalTitleDefName)
Else
	Logger.Info("No title block found on the active sheet")

End If
End Sub

Sub DeleteTitle()

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

	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If Not oSheet.TitleBlock Is Nothing Then
			oSheet.TitleBlock.Delete
		End If
	Next

End Sub

Sub InsertTitleBlock(oOriginalTitleDefName As String)

	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet As Sheet = oDrawDoc.ActiveSheet
	Dim TitleBlockDef As TitleBlockDefinition

	strTitleBlockRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument

	SourceFile = "C:\Users\rvaldivia\Desktop\Codigos\Templates\H+K Parts (mm).idw"

	Dim strSourceIDW As DrawingDocument
	Try
		strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)
	Catch ex As Exception
		Logger.Info(ex.Message)
		MsgBox("Could not open source IDW....", , "Test message")
		Return
	End Try

	oFound = False
	For Each TitleBlockDef In strSourceIDW.TitleBlockDefinitions
		If (StrComp(TitleBlockDef.Name, oOriginalTitleDefName, vbTextCompare) = 0) Then
			Logger.Info(TitleBlockDef.Name)
			CopyFrom = TitleBlockDef.CopyTo(strDrawDoc, True)
			oFound = True
		End If
	Next

	If oFound = False Then
		Logger.Info(TitleBlockDef.Name & " not found in source IDW")
	End If

	strSourceIDW.Close()

	Dim oNewTitleBlockDef As TitleBlockDefinition

	oNewTitleBlockDef = oDrawDoc.TitleBlockDefinitions.Item(oOriginalTitleDefName)

	For Each oSheet In oDrawDoc.Sheets
		oSheet.AddTitleBlock(oNewTitleBlockDef)
	Next

End Sub

rebes_31 · ‎06-29-2021

Hello @Curtis_Waguespack

I tried with this code and it send me the same error
The parameter is incorrect. (Exception from HRESULT: 0x80070057 (E_INVALIDARG)) ☹️

I think the code finds the file, but it does not insert into the new drawing.

Curtis_Waguespack · ‎06-29-2021

Hi @rebes_31

You'll need to use the logger to see where in the code the problem originates.... see the link in my last post concerning opening and viewing the iLogic logger.

If you can determine the issue, I might be able to assist further, otherwise it is a guess.

Note that the code does work on my computer, so there must be something in your files or paths that is causing the issue.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

rebes_31 · ‎07-29-2021

Hello I´m back

This appears in the iLogic logger

INFO|H+K Title Block not found in source IDW

Could you please help me?

checkcheck_master · ‎07-28-2022

@Curtis_Waguespack

Hi Curtis,

Can you please help me.
I get an error that I can't figure out on line 53, see picture:
'CopyFrom = borderDef.CopyTo(strDrawDoc, True)'
The existing Border is neatly deleted, after which this error message follows.
In both documents the Border has the same name: 'Default Border'.
I also see that name in the logger.info

Thanks in advance.

Sub Main()

Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDrawDoc.ActiveSheet
Dim oBorder As Border = oSheet.Border
	If Not oSheet.Border Is Nothing Then
		oOriginalBorderDefName = oSheet.Border.Definition.Name
		Logger.Info(oOriginalBorderDefName)

		DeleteBorders()
		
		' -------------------------------------------------------------------------------------------------
		' Use DoEvents to force Inventor to wait till the code is finished...
		ThisApplication.UserInterfaceManager.DoEvents
		
		InsertBorder(oOriginalBorderDefName)
	End If
End Sub

Sub DeleteBorders()

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

	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If Not oSheet.Border Is Nothing Then
	        oSheet.Border.Delete			
	    End If
	Next

End Sub

Sub InsertBorder(oOriginalBorderDefName As String)
	
		'MessageBox.Show("Here...")
	
	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet As Sheet = oDrawDoc.ActiveSheet
	Dim borderDef As BorderDefinition
	
	strBorderRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	SourceFile = "C:\Workingfolder\CAD Settings\Inventor\Templates\HML Drawing.dwg"
	
   	Dim strSourceIDW As DrawingDocument
    	strSourceIDW = ThisApplication.Documents.Open(SourceFile, True)
	Logger.Info(strSourceIDW.FullFileName)
	
	For Each borderDef In strSourceIDW.BorderDefinitions
        If (StrComp(borderDef.Name, oOriginalBorderDefName, vbTextCompare) = 0) Then
            CopyFrom = borderDef.CopyTo(strDrawDoc, True)
       	End If
	Next	
	
	'MessageBox.Show("Here...")
	
	strSourceIDW.Close()
	

	Dim oNewBorderDef As BorderDefinition
	oNewBorderDef = oDrawDoc.BorderDefinitions.Item(oOriginalBorderDefName)

	For Each oSheet In oDrawDoc.Sheets
		oSheet.AddBorder(oNewBorderDef)
	Next	
	
	'MessageBox.Show("The border was changed", "Title")

End Sub

Curtis_Waguespack · ‎07-28-2022

Hi @checkcheck_master,

My first guess would be that the border has prompted entry?

If that's the case, then you would need something like this example.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

    ' This border definition contains 2 prompted string inputs.  An array
    ' must be input that contains the values for the prompted strings.
    Dim sPromptStrings(1 To 2) As String
    sPromptStrings(1) = "Hello."
    sPromptStrings(2) = "World."
    
    For each oSheet in oDrawDoc.Sheets
       oSheet.AddBorder(oNewBorderDef, sPromptStrings)
    Next

checkcheck_master · ‎07-28-2022

Thank you Curtis, smart to think of that.
I've come across it before with a Title Block replaced and seen it pass by but can't get my fingers behind it.

The code still keeps stumbling at that 'CopyTo'.
See the whole code where you can see what I'm bumbling around.
Those Prompted Entries do come across well with updating the title block.
I have also tried the same kind of technique with the border, but at a certain point my knowledge falls short.
I still don't understand why it is so difficult with the border.

Btw, maybe it says something, I haven't seen that message at the end of the sub 'InsertBorder' yet, somehow it doesn't get there.

Sub Main

Dim oDoc As DrawingDocument

oDoc = ThisApplication.ActiveDocument

' Point to template to get title block from
ThisDrawing.ResourceFileName = "C:\Workingfolder\CAD Settings\Inventor\Templates\HML Drawing.dwg"
							
Dim oCurrentNumber As Sheet
oCurrentNumber = oDoc.ActiveSheet

Dim oSheet As Sheet
oSheet = oDoc.ActiveSheet

'----------------------------------------------------------------------------------------------------
' Undo Wrapper
Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "Do your thing...")
'----------------------------------------------------------------------------------------------------

' Uncheck Checked Dates
iProperties.Value("Status", "Checked Date") = Nothing
iProperties.Value("Status", "Checked By") = Nothing  

Dim valQTY As String = ""
Dim valFINISHING As String = ""

For Each oSheet In oDoc.Sheets
oSheet.Activate

	If Not ActiveSheet.TitleBlock = "" Then
	
		'Get the Prompted Entries, QTY and FINISH
		' Let op, als we zoeken op bv 'QTY' komt dat twee keer voor, onduidelijk wanneer het de waarde betreft of niet, vandaar de 'If <> "QTY" then...' enz.
'		Dim valQTY As String = ""
'		Dim valFINISHING As String = ""

		Dim oPromptEntry
		Dim actSheet As Sheet = ThisApplication.ActiveDocument.ActiveSheet

		'For Each oSheet In oDoc.Sheets
		    ActiveSheet=ThisDrawing.Sheet(oSheet.Name)
		    If oSheet.TitleBlock Is Nothing Then Exit Sub
		    oTitleBlock=oSheet.TitleBlock
		    oTextBoxes=oTitleBlock.Definition.Sketch.TextBoxes
		    For Each oTextBox In oTitleBlock.Definition.Sketch.TextBoxes
				
				'On Error Resume Next
				If oTextBox.Text <>"" Then
					Select oTextBox.Text
					    Case "QTY":
							'oPromptEntry = ThisPurposeForIssue
							If oTitleBlock.GetResultText(oTextBox) <> "QTY" Then
								'MessageBox.Show(oTitleBlock.GetResultText(oTextBox), "QTY")
								valQTY = oTitleBlock.GetResultText(oTextBox)
							End If
						Case "FINISHING":
							'oPromptEntry = ThisPurposeForIssue
							If oTitleBlock.GetResultText(oTextBox) <> "FINISHING" Then
								'MessageBox.Show(oTitleBlock.GetResultText(oTextBox), "FINISHING")
								valFINISHING = oTitleBlock.GetResultText(oTextBox)
							End If
					End Select
				End If
		    Next
		'Next		
		
		' Rename TitleBlock so it can be replaced completely, later unused TitleBlocks are removed
		'On Error Resume Next
		For Each oTitleBlock In oDoc.TitleBlockDefinitions
			If oTitleBlock.Name = "HML" Then
				oTitleBlock.Name = "HML_Old"
			End If
		Next	
		
		' Place 'New' Titleblock
		' There Is a different Call For title blocks which contain prompted entries
		
		'ActiveSheet.SetTitleBlock("HML", valQTY, "Kijk maar! Doe maar wat!")	
		ActiveSheet.SetTitleBlock("HML", valQTY, valFINISHING)
		
		'ActiveSheet.SetTitleBlock("HML", "-", "See Paint Specification List") ' "QTY" "FINISHING"
		'ActiveSheet.SetTitleBlock("HML", "promptedEntry1", "promptedEntry2")
		'ActiveSheet.TitleBlock = "HML"
		
		
'		' Try to set the Border
'		'On Error Resume Next
'		oBorder=oSheet.Border
'		For Each oBorder In oDoc.BorderDefinitions
'			If oBorder.Name = "Default Border" Or oBorder.Name = "HML Border" Then
'				oBorder.Name = "HML_Border_Old"
'			End If
'		Next

'		Try
'			oSheet.Border.Delete
'		Catch
'		End Try
		
'		Try
'			ActiveSheet.SetBorder("HML_Border", "", "")
'		Catch
'		End Try
		
	End If

Next 

' Delete unused title block(s) from Drawing Recources
'On Error Resume Next '(The used Title Block can not be deleted)
For Each oTitleBlock In oDoc.TitleBlockDefinitions
	Try
		oTitleBlock.delete()	
	Catch
	End Try
Next



''Delete unused Borders from Drawing Recources
''On Error Resume Next '(The used Border can not be deleted)
'Dim oBorder As Border
'For Each oBorder In oDoc.BorderDefinitions
'	Try
'		MessageBox.Show("oborder.name: " & oBorder.Name)
'		oBorder.Delete()	
'	Catch
'	End Try
'Next	

'Dim oObj As ObjectCollection(Of String) 
'oObj.Add(valQTY.ToString)
'oObj.Add(valFINISHING.ToString)

'Dim sPromptStrings(2) As String
'    sPromptStrings(1) = valQTY
'    sPromptStrings(2) = valFINISHING


'oSheet.AddBorder("Default Border",sPromptStrings)

	
	
'	Dim oNewBorderDef As BorderDefinition
'	oNewBorderDef = oDoc.BorderDefinitions.Item(oOriginalBorderDefName)

'	For Each oSheet In ThisApplication.ActiveDocument.Sheets
'		If Not oSheet.Border Is Nothing Then
'	        oSheet.Border.Delete			
'	    End If
'	Next


'	If Not oSheet.Border Is Nothing Then
'			oOriginalBorderDefName = oSheet.Border.Definition.Name
'			Logger.Info(oOriginalBorderDefName)
'	End If
	
'	For Each oSheet In oDoc.Sheets
'		oSheet.AddBorder(oNewBorderDef)
'	Next






	Dim oBorder As Border = oSheet.Border
	If Not oSheet.Border Is Nothing Then
		oOriginalBorderDefName = oSheet.Border.Definition.Name
		Logger.Info(oOriginalBorderDefName)

		DeleteBorders()
		
		'MessageBox.Show("Here...")
		
		InsertBorder(oOriginalBorderDefName)			
		
	End If

	





	







' Set Date and Author
	'oTime = Now.ToShortDateString
	'iProperties.Value("Project", "Creation Date") = oTime
	'iProperties.Value("Summary", "Author") = "CNo"

iLogicVb.UpdateWhenDone = True

'Back to current/active sheet
oCurrentNumber.Activate

'----------------------------------------------------------------------------------------------------			
' Undo Wrapper
trans.End()

'----------------------------------------------------------------------------------------------------
' Copy Sketch Symbols from Drawing Template into this Drawing
Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
Dim SourceFile As String = ThisDrawing.ResourceFileName '"D:\Local Server\Data\Autodesk Customization\Templates\IV2014Stamps.idw" 

Dim strSourceIDW As DrawingDocument
strSourceIDW = ThisApplication.Documents.Open(SourceFile, False)
Dim strStampList As New List( Of String)
Dim symbolDef As SketchedSymbolDefinition

' Remove unused Sketch Symbols
For Each symbolDef In strDrawDoc.SketchedSymbolDefinitions
	Try
		symbolDef.Delete
	Catch
		'MessageBox.Show("Error deleting Sketched Symbol: " & symbolDef.Name, "InventorPLUS", MessageBoxButtons.OK, MessageBoxIcon.Information)
	End Try
Next

' Add Symbols to the List
For Each symbolDef In strSourceIDW.SketchedSymbolDefinitions
    strStampList.Add(symbolDef.Name)
Next

' Sort List with Sketch Symbols
strStampList.Sort

'strSelectedStamp = InputListBox("Please select a stamp.", strStampList, strSelectedStamp, "Stamp Selection", "Available Stamps")

For Each symbolDef In strSourceIDW.SketchedSymbolDefinitions
'    'If (StrComp(symbolDef.Name, strSelectedStamp, vbTextCompare) = 0) Then
        CopyFrom = symbolDef.CopyTo(strDrawDoc, True)

'        'If MsgBox("Would you like to place the stamp on the drawing?", MsgBoxStyle.YesNo, "Insert Stamp") = MsgBoxResult.Yes Then
'        '    'Insert stamp if required
'        '    InsertSymbol(symbolDef.Name)
'        'End If
    
'	'End If
Next

'----------------------------------------------------------------------------------------------------
' Sort the Sketch Symbols
ThisApplication.ActiveDocument.BrowserPanes("Model").TopNode.BrowserNodes.Item("Drawing Resources").BrowserNodes.Item(4).DoSelect

Dim oCommandMgr As CommandManager
oCommandMgr = ThisApplication.CommandManager

Dim oControlDef1 As ControlDefinition
oControlDef1 = oCommandMgr.ControlDefinitions.Item("DrawingResourceSort")
oControlDef1.Execute

'----------------------------------------------------------------------------------------------------
strSourceIDW.Close()

End Sub

Sub DeleteBorders()

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

	For Each oSheet In ThisApplication.ActiveDocument.Sheets
		If Not oSheet.Border Is Nothing Then
	        oSheet.Border.Delete			
	    End If
	Next

End Sub

Sub InsertBorder(oOriginalBorderDefName As String)

	
		MessageBox.Show("Here...")
		

	Dim oDrawDoc As DrawingDocument = ThisApplication.ActiveDocument
	Dim oSheet As Sheet = oDrawDoc.ActiveSheet
	Dim borderDef As BorderDefinition
	
	strBorderRequired = True

	Dim strDrawDoc As Inventor.DrawingDocument = ThisApplication.ActiveDocument
          	
	SourceFile = "C:\Workingfolder\CAD Settings\Inventor\Templates\HML Drawing.dwg"
	
   	Dim strSourceIDW As DrawingDocument
    	strSourceIDW = ThisApplication.Documents.Open(SourceFile, True)
	Logger.Info(strSourceIDW.FullFileName)
	
	For Each borderDef In strSourceIDW.BorderDefinitions
        If (StrComp(borderDef.Name, oOriginalBorderDefName, vbTextCompare) = 0) Then
            CopyFrom = borderDef.CopyTo(strDrawDoc, True)
       	End If
	Next	
	
	'MessageBox.Show("Here...")
	
	strSourceIDW.Close()
	

	Dim oNewBorderDef As BorderDefinition
	oNewBorderDef = oDrawDoc.BorderDefinitions.Item(oOriginalBorderDefName)
	
'	For Each oSheet In oDrawDoc.Sheets
'		oSheet.AddBorder(oNewBorderDef)
'	Next
	
	' This border definition contains 2 prompted string inputs.  An array
    ' must be input that contains the values for the prompted strings.
    Dim sPromptStrings(0 To 1) As String
    sPromptStrings(0) = "Hello."
    sPromptStrings(1) = "World."
    
    For Each oSheet In oDrawDoc.Sheets
       oSheet.AddBorder(oNewBorderDef, sPromptStrings)
    Next	
	
	MessageBox.Show("The border was changed", "Title")

End Sub

Curtis_Waguespack · ‎07-28-2022

Hi @checkcheck_master ,

My apologies for the confusion, I replied in a hurry this morning as I was getting ready to go to a meeting. But in looking at this now, I see that the issue is the Copy line, not the Add line... so my suggestion about prompted entry would likely not have helped even if prompts were involved.

I just set up a simple example with this as the only change from your first example:

SourceFile = "C:\Temp\HML Drawing.dwg"

...and it runs without issues.

The only thing that came to mind that would create an error at the Copy line, might be is the destination drawing has a Sheet Format that is using the border. In that case it might hang onto the old border definition and not allow it to copy... however I did a simple test with a sheet format, and didn't see the error then either.

I hope this helps.
Best of luck to you in all of your Inventor pursuits,
Curtis
http://inventortrenches.blogspot.com

checkcheck_master · ‎07-28-2022

Thank you again Curtis.
I just lost him a little.
I have changed the location of the source but it keeps giving me an error on that CopyTo line.
I don't really understand why he couldn't get to that earlier location.
What am I doing wrong?
Can I see your complete code please?

checkcheck_master · ‎07-28-2022

@Curtis_Waguespack

I tackled him in a different way Curtis, see code.

https://help.autodesk.com/view/INVNTOR/2022/ENU/?guid=Sheet_AddDefaultBorder

' -------------------------------------------------------------------------------------------------------------------------------------------------------------
			' Check to see if the sheet already has a border and delete it if it does.
		    If Not oSheet.Border Is Nothing Then
		        oSheet.Border.Delete
		    End If
		    
		    ' Define the values to use as input for the border creation.
		    Dim HorizontalZoneCount As Double
		    HorizontalZoneCount = 0
		    
		    Dim HorizontalZoneLabelMode As BorderLabelModeEnum
		    HorizontalZoneLabelMode = BorderLabelModeEnum.kBorderLabelModeNone
			
		    Dim VerticalZoneCount As Double
		    VerticalZoneCount = 0
		    
		    Dim VerticalZoneLabelMode As BorderLabelModeEnum
		    VerticalZoneLabelMode = BorderLabelModeEnum.kBorderLabelModeNone
		    
		    Dim LabelFromBottomRight As Boolean
		    LabelFromBottomRight = False
		     
		    Dim DelimitByLines As Boolean
		    DelimitByLines = False
		    
		    Dim CenterMarks As Boolean
		    CenterMarks = False
		    
		    Dim TopMargin As Double
		    TopMargin = .5
		    
		    Dim BottomMargin As Double
		    BottomMargin = .5
			
		    Dim LeftMargin As Double
		    LeftMargin = .5
		    
		    Dim RightMargin As Double
		    RightMargin = .5
		
			Dim TextStyle As Object 
			Dim TextLayer As Object
			Dim LineLayer As Object    
			
			' Add the border to the sheet
		    Dim oBorder As DefaultBorder										  
			oBorder = oSheet.AddDefaultBorder(	HorizontalZoneCount, _
												HorizontalZoneLabelMode, _
												VerticalZoneCount, _
												VerticalZoneLabelMode, _
												LabelFromBottomRight, _
												DelimitByLines, _
												CenterMarks, TopMargin, _
												BottomMargin, LeftMargin, _
												RightMargin, _
												TextStyle, _
												TextLayer, _
												LineLayer)

Community

Add border of a path

Add border of a path

Add border of a path