Hi all,
I am trying to create i kind of autoballoon function.
I found that it is pretty hard to move the leaderpoitn that has the arrow on it.
but now i want to use the location where the balloon leader is starting to relocate the balloons.
The startpoint of the leader is created using the 'creategeometryintent' function.
for this function i use a curve as input, and the output is a point2D.
now the problem is that when i want to read the coordinates point, but when i put this in a messagebox i get an error.
also when i create a paramter as a double and write the coordinate to this, it wont work.
can someone explain why i cannot read the coordinates of this point?
this code can be run from any drawing with at least 4 views in it, so feel free to try.
Dim oDrawing As DrawingDocument = ThisApplication.ActiveDocument Dim oSheet As Sheet = oDrawing.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(4) Dim oReferDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument Dim oAssyDef As AssemblyComponentDefinition = oReferDoc.ComponentDefinition Dim Occ As ComponentOccurrence Dim oCurve As DrawingCurve For Each Occ In oAssyDef.Occurrences If oView.DrawingCurves(Occ).Count > 0 Then Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(Occ) oCurve = oCurves.Item(1) MsgBox("Curves found") Else GoTo Volgende End If 'Dim oDrawingCurve As DrawingCurve = oActiveSheet.DrawingViews.Item(4).DrawingCurves.Item(i) Dim oMidpoint As Point2d Try If oCurve.CurveType <> 5124 Then oMidpoint = oCurve.MidPoint Else oMidpoint = oCurve.CenterPoint End If Catch End Try ' Set a reference to the TransientGeometry object. Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Dim oLeaderPoints As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection ' Create a couple of leader points. Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidpoint.X + 10, oMidpoint.Y + 10)) Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidpoint.X + 10, oMidpoint.Y + 5)) ' Add the GeometryIntent to the leader points collection. ' This is the geometry that the balloon will attach to. Dim oGeometryIntent As GeometryIntent = oSheet.CreateGeometryIntent(oCurve) Dim xcord As Double = oGeometryIntent.PointOnSheet.X MsgBox(xcord) ' MsgBox(oGeometryIntent.PointOnSheet.X & " " & oGeometryIntent.PointOnSheet.Y) Call oLeaderPoints.Add(oGeometryIntent) ' Set a reference to the parent drawing view of the selected curve Dim oDrawingView As DrawingView = oCurve.Parent ' Set a reference to the referenced model document Dim oModelDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument ' Check if a partslist or a balloon has already been created for this model Dim IsDrawingBOMDefined As Boolean IsDrawingBOMDefined = oDrawing.DrawingBOMs.IsDrawingBOMDefined(oModelDoc.FullFileName) Dim oBalloon As Balloon If IsDrawingBOMDefined Then ' Just create the balloon with the leader points ' All other arguments can be ignored oBalloon = oDrawing.ActiveSheet.Balloons.Add(oLeaderPoints) Else ' First check if the 'structured' BOM view has been enabled in the model ' Set a reference to the model's BOM object Dim oBOM As BOM = oModelDoc.ComponentDefinition.BOM If oBOM.StructuredViewEnabled Then ' Level needs to be specified ' Numbering options have already been defined ' Get the Level ('All levels' or 'First level only') ' from the model BOM view - must use the same here Dim Level As PartsListLevelEnum If oBOM.StructuredViewFirstLevelOnly Then Level = kStructured Else Level = kStructuredAllLevels End If oBalloon = oSheet.Balloons.Add(oLeaderPoints, , Level) Else Dim oNumberingScheme As NameValueMap= ThisApplication.TransientObjects.CreateNameValueMap oNumberingScheme.Add ("Delimiter", ",") oBalloon = oSheet.Balloons.Add(oLeaderPoints, , kStructuredAllLevels, oNumberingScheme) End If End If Volgende: Next Dim bloon As Balloon Dim compare As String = "" For Each bloon In oSheet.Balloons If compare = bloon.BalloonValueSets.Item(1).Value Then bloon.Delete Else compare = bloon.BalloonValueSets.Item(1).Value End If Next
Solved! Go to Solution.
Solved by JelteDeJong. Go to Solution.
Okay, So for intereseted people i have an update.
apparently the geometryintent is empty.
when checking the code in VBA the it is empty trhough the entire code.
so how the balloon can connect to a line is very strange.
Also i found out that a balloon doesnt strat at the arrow, but at the balloon(circle),
This is something different then when you want to place them manually.
I Also tried moving the rootnode of the balloon using a prefixed point2D.
I don't get any errors when doing this, but it also doesn't move anything.
How is it not possible to modify anything to a balloon when you have already placed them.
so i have two options that both don't work (in red):
1: read the point where the balloon is connected to the part, and then give it a leaderpoint accordingly
2: read the last leadernode of the balloon and then move the rootnode accordingly
is there any option to do this in code or is this so deep into the program that it is not possible?
Kind regards,
hi in your code where you try to get the GeometryIntent, i dont see a property/eNum to tell inventor wich point on the curve you want to use. therefor you need to use the enum: "PointIntentEnum". Pay attension that not all types of curves have the same points. for example a line does not have a centerpoint (that is for circular curves) but does have a mid point.
you could try to replace the line:
Dim oGeometryIntent As GeometryIntent = oSheet.CreateGeometryIntent(oCurve)
with:
Dim geoType = oCurve.Segments.Item(1).GeometryType Dim oGeometryIntent As GeometryIntent If (geoType = Curve2dTypeEnum.kLineSegmentCurve2d) Then oGeometryIntent = sheet.CreateGeometryIntent(oCurve, PointIntentEnum.kStartPointIntent) ElseIf (geoType = Curve2dTypeEnum.kCircleCurve2d) Then oGeometryIntent = sheet.CreateGeometryIntent(oCurve, PointIntentEnum.kCircularLeftPointIntent) End If
for your situation you might want to change the PointIntentEnum.?????? to something else. See help for all options.
(disclamer: i did not have time to try this out but expect that it would work.)
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
Thanks for the answer!
I didn't know i could specify a certain type of point to the geometryintent.
I also found out how to move the balloon around the sheet.
It is not possible moving the balloon with a X and Y coordinate seperate, but you have to assign a point2D to the position, something like this:
Dim Point As Point2d = oTG.CreatePoint2d(6, 10) oBalloon.Leader.AllNodes.Item(1).Position = Point
i will post my code here if i got it working functionally
kind regards,
so for everyone interested in an autoballoon function. the code i have so far works.
Only thing to modify is that the leaders can intersect each other, so that is something to improve.
the code is created with the intention to only balloon the iso view that is view 4.
Imports Inventor.CurveTypeEnum Imports System.IO Sub Main() Dim oDrawing As DrawingDocument = ThisApplication.ActiveDocument Dim oSheet As Sheet = oDrawing.ActiveSheet Dim oView As DrawingView = oSheet.DrawingViews.Item(4) Dim oReferDoc As AssemblyDocument = oView.ReferencedDocumentDescriptor.ReferencedDocument Dim oAssyDef As AssemblyComponentDefinition = oReferDoc.ComponentDefinition Dim Occ As ComponentOccurrence Dim oCurve As DrawingCurve Dim oLine As DrawingCurve Dim oTG As TransientGeometry = ThisApplication.TransientGeometry For Each Occ In oAssyDef.Occurrences If oView.DrawingCurves(Occ).Count > 0 Then Dim oCollection As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves(Occ) For Each oCurve In oCurves If oCurve.CurveType = kLineSegmentCurve Then Call oCollection.Add(oCurve) End If Next If oCollection.Count > 0 Then oLine = oCollection.Item(1) Else oLine = oCurves.Item(1) End If ' oCurve = oCurves.Item(1) ' MsgBox("Curves found") Else GoTo Volgende End If Dim oMidpoint As Point2d Dim oGeometryIntent As GeometryIntent Try If oLine.CurveType <> 5124 Then oMidpoint = oLine.MidPoint oGeometryIntent = oSheet.CreateGeometryIntent(oLine, PointIntentEnum.kMidPointIntent) Else oMidpoint = oLine.CenterPoint oGeometryIntent = oSheet.CreateGeometryIntent(oLine, PointIntentEnum.kCircularLeftPointIntent) End If Catch End Try ' Set a reference to the TransientGeometry object. Dim VmX As Double = oView.Center.X Dim VmY As Double = oView.Center.Y Dim PX As Double = oMidpoint.X Dim PY As Double = oMidpoint.Y Dim Vw As Double = oView.Width Dim Vh As Double = oView.Height ' MsgBox("VmX: " & VmX & " VmY: " & VmY & vbNewLine & "PX: " & PX & " PY: " & PY & vbNewLine & "Vw: " & Vw & " Vh: " & Vh) Dim oLeaderPoints As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection If PX < VmX And PY > VmY Then If PY < (((VmX - PX) / (0.5 * Vw)) * (0.5 * Vh)) + VmY Then Call oLeaderPoints.Add(oTG.CreatePoint2d(VmX - (0.5 * Vw) - 1, PY)) 'A Else Call oLeaderPoints.Add(oTG.CreatePoint2d(PX, VmY + (0.5 * Vh) + 1)) 'B End If ElseIf PX > VmX And PY > wmy Then If PY < (((PX - VmX) / (0.5 * Vw)) * (0.5 * Vh)) + VmY Then Call oLeaderPoints.Add(oTG.CreatePoint2d(VmX + (0.5 * Vw) + 1, PY)) 'D Else Call oLeaderPoints.Add(oTG.CreatePoint2d(PX, VmY + (0.5 * Vh) + 1)) 'C End If ElseIf PX > VmX And PY < VmY Then If PY > (((PX - VmX) / (0.5 * Vw)) * (0.5 * Vh)) + VmY Then Call oLeaderPoints.Add(oTG.CreatePoint2d(VmX + (0.5 * Vw) + 1, PY)) 'E Else Call oLeaderPoints.Add(oTG.CreatePoint2d(PX, VmY - (0.5 * Vh) - 1)) 'F End If ElseIf PX < VmX And PY < VmY Then If PY > (((VmX - PX) / (0.5 * Vw)) * (0.5 * Vh)) + VmY Then Call oLeaderPoints.Add(oTG.CreatePoint2d(VmX - (0.5 * Vw) - 1, PY)) 'H Else Call oLeaderPoints.Add(oTG.CreatePoint2d(PX, VmY - (0.5 * Vh) - 1)) 'G End If End If ' Dim oTG As TransientGeometry = ThisApplication.TransientGeometry ' Dim oLeaderPoints As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection ' Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidpoint.X + 10, oMidpoint.Y + 10)) Call oLeaderPoints.Add(oGeometryIntent) ' Set a reference to the parent drawing view of the selected curve Dim oDrawingView As DrawingView = oCurve.Parent ' Set a reference to the referenced model document Dim oModelDoc As Document = oView.ReferencedDocumentDescriptor.ReferencedDocument ' Check if a partslist or a balloon has already been created for this model Dim IsDrawingBOMDefined As Boolean IsDrawingBOMDefined = oDrawing.DrawingBOMs.IsDrawingBOMDefined(oModelDoc.FullFileName) Dim oBalloon As Balloon If IsDrawingBOMDefined Then ' Just create the balloon with the leader points ' All other arguments can be ignored oBalloon = oDrawing.ActiveSheet.Balloons.Add(oLeaderPoints) Else ' First check if the 'structured' BOM view has been enabled in the model ' Set a reference to the model's BOM object Dim oBOM As BOM = oModelDoc.ComponentDefinition.BOM If oBOM.StructuredViewEnabled Then ' Level needs to be specified ' Numbering options have already been defined ' Get the Level ('All levels' or 'First level only') ' from the model BOM view - must use the same here Dim Level As PartsListLevelEnum If oBOM.StructuredViewFirstLevelOnly Then Level = kStructured Else Level = kStructuredAllLevels End If oBalloon = oSheet.Balloons.Add(oLeaderPoints, , Level) Else Dim oNumberingScheme As NameValueMap= ThisApplication.TransientObjects.CreateNameValueMap oNumberingScheme.Add ("Delimiter", ",") oBalloon = oSheet.Balloons.Add(oLeaderPoints, , kStructuredAllLevels, oNumberingScheme) End If End If Volgende: Next Trace.WriteLine("Bloon count: " & oSheet.Balloons.Count) Dim bloon As Balloon Dim compare As String = "" For Each bloon In oSheet.Balloons Trace.WriteLine("Bloon value: " & bloon.BalloonValueSets.Item(1).Value) If compare = bloon.BalloonValueSets.Item(1).Value Then bloon.Delete Else compare = bloon.BalloonValueSets.Item(1).Value End If ' leader = bloon.Leader.AllNodes.Item(1) To bloon.Leader.AllNodes.Item(2) Next Dim TColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection 'top Dim RColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection 'Right Dim BColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection 'Bottom Dim LColl As ObjectCollection = ThisApplication.TransientObjects.CreateObjectCollection 'Left Dim TData As New List(Of Tuple(Of Integer,Double)) Dim RData As New List(Of Tuple(Of Integer,Double)) Dim BData As New List(Of Tuple(Of Integer,Double)) Dim LData As New List(Of Tuple(Of Integer,Double)) Dim count As Integer = 1 For Each bloon In oSheet.Balloons If bloon.Position.Y > oView.Center.Y + (oView.Height * 0.5) Then TData.Add(New Tuple(Of Integer, Double)(Count, bloon.Position.X)) ElseIf bloon.Position.X > oView.Center.X + (oView.Width * 0.5) Then RData.Add(New Tuple(Of Integer, Double)(Count, bloon.Position.Y)) ElseIf bloon.Position.Y < oView.Center.Y - (oView.Height * 0.5) Then BData.Add(New Tuple(Of Integer, Double)(Count, bloon.Position.X)) ElseIf bloon.Position.X < oView.Center.X - (oView.Width * 0.5) Then LData.Add(New Tuple(Of Integer, Double)(Count, bloon.Position.Y)) End If count = count+1 Next If TData.Count>1 Then TData.Sort(New Comparison(Of Tuple(Of Integer, Double))(AddressOf ComparisonTwoTuples)) Movebloon(TData, 0.75, 0) End If If RData.Count>1 Then RData.Sort(New Comparison(Of Tuple(Of Integer, Double))(AddressOf ComparisonTwoTuples)) Movebloon(RData, 0, 0.75) End If If BData.Count>1 Then BData.Sort(New Comparison(Of Tuple(Of Integer, Double))(AddressOf ComparisonTwoTuples)) Movebloon(BData, 0.75, 0) End If If LData.Count>1 Then LData.Sort(New Comparison(Of Tuple(Of Integer, Double))(AddressOf ComparisonTwoTuples)) Movebloon(LData,0, 0.75) End If End Sub Function Movebloon(Data As List(Of Tuple(Of Integer, Double)), moveX As Double, moveY As Double) Dim drawdoc As DrawingDocument = ThisApplication.ActiveDocument Dim oSheet As Sheet = drawdoc.ActiveSheet Dim oTG As TransientGeometry = ThisApplication.TransientGeometry Trace.WriteLine("count " & Data.count) For z = 1 To Data.Count-1 Trace.WriteLine("Z:" & z) 'MsgBox(TData.Item(Z).tostring) Dim CurrItem As Integer = Split(Mid(Data.Item(z-1).tostring, 2, Len(Data.Item(z-1).tostring) -2), ",", 2)(0) Dim NextItem As Integer = Split(Mid(Data.Item(z).tostring, 2, Len(Data.Item(z).tostring) -2), ",", 2)(0) Trace.WriteLine("Curr:" & CurrItem) Dim CurrCoord As Double = oSheet.Balloons.Item(CurrItem).Position.X 'Split(Mid(Data.Item(z).tostring, 2, Len(Data.Item(z).tostring) -2), ",",2)(1) Dim NextCoord As Double = Split(Mid(Data.Item(z).tostring, 2, Len(Data.Item(z).tostring) -2), ",", 2)(1) Trace.WriteLine("Balloon value: " & oSheet.Balloons.Item(CurrItem).BalloonValueSets.Item(1).Value) Trace.WriteLine("result" & (NextCoord - CurrCoord + 0.6)) Dim Point As Point2d If NextCoord < CurrCoord + 0.6 Then Point = oTG.CreatePoint2d(oSheet.Balloons.Item(CurrItem).Position.X + moveX, oSheet.Balloons.Item(CurrItem).Position.Y + moveY) oSheet.Balloons.Item(NextItem).Leader.AllNodes.Item(1).Position = point End If Next End Function Function ComparisonTwoTuples(ByVal tupleA As Tuple(Of Integer, Double), ByVal tupleB As Tuple(Of Integer, Double)) As Double ' Compare the first Item of each tuple in ascending order. Dim part1 As Double = tupleA.Item2 Dim part2 As Double = tupleB.Item2 Dim compareResult As Double = part1.CompareTo(part2) ' If not equal, return the comparison result. If compareResult <> 0 Then Return compareResult End If ' Compare the second item of each tuple in descending order. Return tupleB.Item2.CompareTo(tupleA.Item2) End Function
Can't find what you're looking for? Ask the community or share your knowledge.