Message 1 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I've written some code that places balloons in batch. It opens this form:
I can enter orientation (horizontal/vertical), a filter to define which components should be ballooned and a displacement of the balloon in the X and Y direction. The code also does some more things to the balloons like change the balloon shape based on the text length and hide the leader.
AddReference "MSInventorTools.dll"
Sub Main
Try
' Create a new instance of the form
Dim oForm As New MSInventorTools.frmAutoBalloon
' Exit the sub unless the OK button was clicked
If oForm.ShowDialog <> System.Windows.Forms.DialogResult.OK Then Exit Sub
' Get the data from the form
Dim sComparisonString As String = oForm.sComparisonString
Dim sOrientation As String = oForm.sOrientation
Dim sDisplacementX As String = oForm.sDisplacementX
Dim sDisplacementY As String = oForm.sDisplacementY
' Define the balloon style
Dim sBalloonStyle As String = "GC Balloon Part Number " & sOrientation
' Define the displacement of the balloon
Dim iDisplacementX As Integer = sDisplacementX
Dim iDisplacementY As Integer = sDisplacementY
' Set a reference to the drawing document
Dim oDrawingDoc As DrawingDocument = ThisApplication.ActiveDocument
' Set a reference to the active sheet
Dim oSheet As Sheet = oDrawingDoc.ActiveSheet
' Set a reference to the selected drawing view
Dim oDrawingView As DrawingView = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingViewFilter, "Select Drawing View (Press Esc to cancel)")
' If nothing is selected exit the sub
If oDrawingView Is Nothing Then
Exit Sub
End If
' Get the balloon style definition
Dim oBalloonStyle As BalloonStyle = oDrawingDoc.StylesManager.BalloonStyles.Item(sBalloonStyle)
' Set a reference to the main assembly referenced by the drawing view
Dim oMainAsm As AssemblyDocument = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument
Dim oMainAsmCompDef As AssemblyComponentDefinition = oMainAsm.ComponentDefinition
' Loop through all balloons
For i As Integer = oSheet.Balloons.Count To 1 Step -1
' Set a reference to the balloon
Dim oBalloon As Balloon = oSheet.Balloons.Item(i)
' Check if the balloon value matches the comparison string
If oBalloon.BalloonValueSets.Item(1).Value Like sComparisonString Then
' Delete the balloon
oBalloon.Delete()
End If
Next
' Loop through all top level occurrences in the main assembly
For i As Integer = 1 To oMainAsmCompDef.Occurrences.Count
' Set a reference to the occurrence
Dim oOcc As ComponentOccurrence = oMainAsmCompDef.Occurrences.Item(i)
' Set a reference to the occurrence document
Dim oOccDoc As Document = oOcc.Definition.Document
' Get the occurrence part number
Dim sOccPartNumber As String = oOccDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
' Get the length of the part number
Dim iOccPartNumberLength As Integer = sOccPartNumber.Length
' Check if the occurrence has drawing curves in the selected view and if the part number matches the comparison string
If oDrawingView.DrawingCurves(oOcc).Count <> 0 AndAlso sOccPartNumber Like sComparisonString Then
PlaceBalloon(oDrawingDoc, oSheet, oDrawingView, oBalloonStyle, oOcc, iDisplacementX, iDisplacementY, iOccPartNumberLength)
End If
Next
Catch ex As Exception
End Try
End Sub
Private Sub PlaceBalloon(ByVal oDrawingDoc As DrawingDocument, ByVal oSheet As Sheet, ByVal oDrawingView As DrawingView, ByVal oBalloonStyle As BalloonStyle, ByVal oOcc As ComponentOccurrence, ByVal iDisplacementX As Integer, ByVal iDisplacementY As Integer, ByVal iOccPartNumberLength As Integer)
' Set a reference to the centerpoint of the occurrence
Dim oOccCenterPoint As Inventor.Point = oOcc.MassProperties.CenterOfMass
' Convert the Centerpoint of the occurrence to a point on the sheet
Dim oPositionPoint As Point2d = oDrawingView.ModelToSheetSpace(oOccCenterPoint)
oPositionPoint.X = oPositionPoint.X + iDisplacementX / 10
oPositionPoint.Y = oPositionPoint.Y + iDisplacementY / 10
' Get a drawing curve from the occurrence
Dim oDrawingCurve As DrawingCurve = oDrawingView.DrawingCurves(oOcc).Item(1)
' Get the midpoint of the drawing curve
Dim oGeometryIntent As GeometryIntent
oGeometryIntent = oSheet.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCenterPointIntent)
' Create an object collection for leader points
Dim oLeaderPoints As ObjectCollection
oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection
' Clear the leader points object collection
oLeaderPoints.Clear()
' Add the position point and the geometry intent to the leader points object collection
oLeaderPoints.Add(oPositionPoint)
oLeaderPoints.Add(oGeometryIntent)
' Create a balloon
Dim oBalloon As Balloon = oSheet.Balloons.Add(oLeaderPoints, , PartsListLevelEnum.kFirstLevelComponents, , oBalloonStyle, )
' Remove the leader from the balloon
oBalloon.Leader.AllNodes.Item(1).Delete()
' Determine the sketch symbol to use for the balloon
Dim sSketchSymbol As String = oBalloonStyle.Name & " " & iOccPartNumberLength
' Set the balloon type
Try
' Override the balloon type based on the length of the part number
oBalloon.SetBalloonType(BalloonTypeEnum.kSketchedSymbolBalloonType, oDrawingDoc.SketchedSymbolDefinitions.Item(sSketchSymbol))
' Set the balloon position
oBalloon.Position = oPositionPoint
Catch ex As Exception
' Apply the default balloon type
oBalloon.SetBalloonType(oBalloonStyle.BalloonType)
End Try
End Sub
This all works, but only if a parts list has been placed or a balloon has been created manually before running the code. Is there a way to make this still work in these cases? I'd like to avoid having to place a parts list if possible
Solved! Go to Solution.