Errors out after one loop.

Errors out after one loop.

frank
Explorer Explorer
216 Views
2 Replies
Message 1 of 3

Errors out after one loop.

frank
Explorer
Explorer

Hi All,

I get this error: The parameter is incorrect. (Exception from HRESULT: 0x80070057 (E_INVALIDARG)) after one loop in the following code:  It worked  in releases prior to 2020.  Appreciate any help.  Thanks.  Specific line that errors out is 

If (ThisDrawing.Document.ActiveSheet.Balloons.Item(oIndex).Position.X = oBalloonXPos And ThisDrawing.Document.ActiveSheet.Balloons.Item(oIndex).Position.Y = oBalloonYPos) Then
NewIndex = oIndex
End If
Dim oIndex As Integer 
Dim NewIndex As Integer
Dim oBalloonXPos As Double
Dim oBalloonYPos As Double
Dim oArrowHeadXPos As Double
Dim oArrowHeadYPos As Double
Dim bubs As ObjectCollection
Dim bub As Object
Dim bubcount As Integer
Dim bubscount As Integer
'create collection of balloons
bubs = ThisApplication.TransientObjects.CreateObjectCollection

While True
	bub = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingBalloonFilter, "Select a balloon; press esc when done") 
	' If nothing gets selected then we're done	
	If IsNothing(bub) Then Exit While
	bubs.Add(bub) 
End While

bubcount = ThisApplication.ActiveDocument.ActiveSheet.Balloons.count
MessageBox.Show(bubcount, "Total Balloon Qty")
bubscount = bubs.Count
MessageBox.Show(bubscount, "Balloon Qty Picked")
' If there are selected components we can do something
' bub is a member of bubs collection
For Each bub In bubs
'get and display balloon and leader points get ArrowHeadType
oArrowHeadType = bub.Leader.ArrowHeadType
'MessageBox.Show(oArrowHeadType, "Arrow Head Type")
bub.Leader.ArrowHeadType=71948
oArrowHeadXPos = bub.Leader.AllNodes.Item(2).Position.X
'MessageBox.Show(oArrowHeadXPos, "ArrowHead X")
oArrowHeadYPos = bub.Leader.AllNodes.Item(2).Position.Y
'MessageBox.Show(oArrowHeadYPos, "ArrowHead Y")
oBalloonXPos = bub.Position.X
'MessageBox.Show(oBalloonXPos, "Balloon X")
oBalloonYPos = bub.Position.y
'MessageBox.Show(oBalloonYPos, "Balloon y")
oBalloonDia = bub.Style.BalloonDiameter
'MessageBox.Show(oBalloonDia, "Balloon Diameter")
'create new point for leader
oBasePosition = ThisApplication.TransientGeometry.CreatePoint2d()
oBasePosition.X = oBalloonXPos + (oBalloonDia/4)
'MessageBox.Show(oBasePosition.X, "New X")
oBasePosition.Y = oBalloonYPos + (oBalloonDia/4)
'MessageBox.Show(oBasePosition.Y, "New y")
'move arrowhead end of leader to new point  
For oIndex = 1 To bubcount
If (ThisDrawing.Document.ActiveSheet.Balloons.Item(oIndex).Position.X = oBalloonXPos And ThisDrawing.Document.ActiveSheet.Balloons.Item(oIndex).Position.Y = oBalloonYPos) Then
NewIndex = oIndex
End If
Next 
ThisDrawing.Document.ActiveSheet.Balloons.Item(NewIndex).Leader.AllNodes.Item(2).Position = oBasePosition
Next
InventorVb.DocumentUpdate()

 Thanks in advance

0 Likes
Accepted solutions (1)
217 Views
2 Replies
Replies (2)
Message 2 of 3

J-Camper
Advisor
Advisor
Accepted solution

@frank,

 

I simplified the code some, and it seems to be working well for me in 2023.4.1.  I do not have a copy of 2020 to test with, but try this out:

Dim dDoc As DrawingDocument = TryCast(ThisDrawing.Document, DrawingDocument)
If IsNothing(dDoc) Then Logger.Debug("Not Run In Drawing Document") : Exit Sub

Dim oBalloonPosition As Point2d   'We don't use this for anything more than a pass through object
Dim oArrowHeadPosition As Point2d 'We don't actually use this anywhere
Dim bubs As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection
Dim bub As Balloon 
Dim bubcount As Integer
Dim bubscount As Integer

While True
	bub = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingBalloonFilter, "Select a balloon; press esc when done") 
	' If nothing gets selected then we're done	
	If IsNothing(bub) Then Exit While
	bubs.Add(bub) 
End While

If bubs.Count < 1 Then Logger.Debug("Nothing collected by user selection") : Exit Sub 

'Idetify how many ballons will be changed out of total
bubcount = dDoc.ActiveSheet.Balloons.Count
bubscount = bubs.Count
'Tell user how many balloons will change
MessageBox.Show("This rule will change " & bubscount & " of the total " & bubcount & " balloons on the current sheet", "Notification")

For Each bub In bubs
	'set ArrowHeadType
	bub.Leader.ArrowheadType=71948
	'Get Arrowhead position [this assumes the user did not add vertices to the leader]
	oArrowHeadPosition = bub.Leader.AllNodes.Item(2).Position.Copy 'We don't actually use this anywhere
	'Get Balloon Position
	oBalloonPosition = bub.Position.Copy
	'Get Balloon Position
	oBalloonDia = bub.Style.BalloonDiameter
	'Copy new point for leader
	oBasePosition = oBalloonPosition.Copy
	'Adjust Point based on balloon size
	oBasePosition.X += (oBalloonDia/4)
	oBasePosition.Y += (oBalloonDia/4)
	'move arrowhead end of leader to new point  
	'There is no reason to loop through all the ballons on the sheet because bub
	'was already selected by the user so just keep using it
	bub.Leader.AllNodes.Item(2).Position = oBasePosition.Copy
Next
InventorVb.DocumentUpdate()

 

There are still some unnecessary objects in my opinion, but I'm not sure if you have future plans so I left some in.

 

Let me know if you have any questions, or if it is not working as intended.

Message 3 of 3

frank
Explorer
Explorer

Thank you J-Camper!  Worked great.

0 Likes