Thursday, 19 February 2015

Component tagging

I have just updated my component tagging code; you can use it as an external rule or straight in the drawing. Would like to thank Chris Benner for taking the time to test this. Check out his blog for more Tube and Pipe stuff https://cadtipstricks.wordpress.com/.
I have merged part tagging in the assembly and retrieval in the drawing intro single code that should work like this:







I would recommend that you create a new balloon style called "Tags" or you need to edit the code and add a comment character ' before the line:
oBalloon.Style = oStyles.BalloonStyles.item("Tags")
This code has been stripped out from the inventor help pages.Unfortunately it's only working with curve segment and when trying to get the middle of it as your balloon attachment reference it's not returning anything for circles and ellipses but for the rest it creates a leather point about 0.5 on axis X and 1 Y .So you can increase these values to get the balloon further away from your reference.

Limitations:
The assemblies need to be checked out, including the runs that contain the parts to tag (valve and all).
Sometimes when you work with different level of details and designs view representations it fails finding the component occurrence so that's why I'm asking you to place a parts list on the drawing sheet (the code tracks and reports if this is the case).
You can’t have same name for different components inside an assembly, so the code will prompt you to try again if you type in an existing value. Ex.: Inside each Route you can have only one valve code V101.
In the tag window dialog if you press cancel it reverts to the original value but make sure you update all balloons at the end when prompted.

You can change the balloon style hexagon linear circular, you can change the display diameter size ; you can change the format of the text but I would much rather change it in the style manager of the drawing create a new style and assign the balloon to it instead of manually entering all these parameters inside the code.
 The second part of the code prompts for update on existing balloons. Here is the code to download.


'this sets a tag to each selected component and creates
'a balloon for it, asks for update of existing balloons
 
' Set a reference to the drawing document.
' This assumes a drawing document is active.
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
 
' Set a reference to the active sheet.
Dim oActiveSheet As Sheet
oActiveSheet = oDrawDoc.ActiveSheet
 
 
Dim oStyles As DrawingStylesManager
oStyles = oDrawDoc.StylesManager
 
Dim oCurve As DrawingCurve
Dim oEdge As EdgeProxy
Dim occurrence As ComponentOccurrence 
Dim oGeometryIntent As GeometryIntent
 
 
While True
    Try
        ' Get a drawing curve segment selection from the user
        Dim oCS As DrawingCurveSegment
        oCS = ThisApplication.CommandManager.Pick( _
                SelectionFilterEnum.kDrawingCurveSegmentFilter, "Pick a drawing curve segment")
                                            
        If oCS Is Nothing Then
            'MessageBox.Show ("Selection was cancelled","ilogic")
            Beep
            Exit While
        End If
                
        oCurve = oCS.Parent
        oEdge = oCurve.ModelGeometry
        occurrence = oEdge.ContainingOccurrence
        
        'MessageBox.Show("Old Occ name: " & occurrence.Name,"ilogic")
        
        Retry = True
        
        'as long as retry is selected by user
        While Retry
            'get tag from user
            oTagOcc = InputBox("Enter Tag No: ", "Tag Prompt", occurrence.Name)
 
            Try
                ' try and set that value
                occurrence.Name = oTagOcc
                'if success exit the retrying loop
                Exit While
            'if tag allready exists
            Catch
                'prompt if user wants to try again
                Retry = InputRadioBox("Allready used, try again", "Yes", "No", Retry, Title := "Retry")
            End Try
        End While
        
        'if user canceled the retry skip the rest of the code and
        'prompt to select parts again
        If Retry = False Then
            Continue While
        End If
 
        'Get the mid point of the selected curve
        ' assuming that the selection curve is linear
        Dim oMidPoint As Point2d
        oMidPoint = oCurve.MidPoint
        
        ' Set a reference to the TransientGeometry object.
        Dim oTG As TransientGeometry
        oTG = ThisApplication.TransientGeometry
        
        Dim oLeaderPoints As ObjectCollection
        oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection
        
        Try
            ' Create a couple of leader points.
            Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 0.5, oMidPoint.Y + 1))
            'Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 1, oMidPoint.Y + 0.5))
        Catch
            MessageBox.Show("Circular segment found," & _
            vbLf & "Can't get sement center," & _
            vbLf & "Manually move balloon please", _
            "Position error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
        
        ' Add the GeometryIntent to the leader points collection.
        ' This is the geometry that the balloon will attach to.
        oGeometryIntent = oActiveSheet.CreateGeometryIntent(oCurve)
        
        Call oLeaderPoints.Add(oGeometryIntent)
        
        Dim oBalloon As Balloon
        Try
            oBalloon = oDrawDoc.ActiveSheet.Balloons.Add(oLeaderPoints)
        Catch 
            MessageBox.Show("Can'te activate BOM." & _
            vbLf & "Temporary add a Parts List on the sheet" & _
            vbLf & "You can remove it later", "ilogic")
        End Try
        
        'set the style of the balloon to "Tags"; if you don't have a style called tags
        'you can remove this to keep it as default or use some of these settings:
        'oBalloon.SetBalloonType (kHexagonBalloonType)
        '---------
        'other options here are kCircularWithOneEntryBalloonType, 
        'kCircularWithTwoEntriesBalloonType, kHexagonBalloonType, 
        'kLinearBalloonType, kNoneBalloonType And kSketchedSymbolBalloonType
        '---------
        oBalloon.Style = oStyles.BalloonStyles.item("Tags")
        
        Dim oBalloonValueSet As BalloonValueSet
            
        ' Iterate over each value set (attached balloons) in a balloon.
        For Each oBalloonValueSet In oBalloon.BalloonValueSets
            ' Set balloon value from browser.
            oBalloonValueSet.OverrideValue = occurrence.Name
        Next
 
    Catch
    'end try
    End Try
End While
 
'----------Update existing balloons on all sheets
 
'Ask the user if he wants to update values of all balloons (if edited some)
booleanParam = InputRadioBox("Update existing balloons?: ", "Yes", "No", True, Title :="Update Existing?")
 
If booleanParam = False Then
    Exit Sub
ElseIf booleanParam = True
    
'process all sheets
For Each oSheets In oDrawDoc.Sheets 
        ' Iterate over each balloon on the sheet.
        For Each oBalloon In oActiveSheet.Balloons
            If oBalloon.Style.Name = "Tags" Then
                Try
                    Dim leader As Leader
                    Leader = oBalloon.Leader
                    'assuming the leader is a single line segment
                    Dim leaderNode As LeaderNode 
                    leaderNode = leader.AllNodes(2)
                    
                    oGeometryIntent = leaderNode.AttachedEntity
                
                    curve = oGeometryIntent.Geometry
                
                    oEdge = curve.ModelGeometry
        
                    occurrence = oEdge.ContainingOccurrence
                    
                    ' Iterate over each value set (attached balloons) in a balloon.
                    For Each oBalloonValueSet In oBalloon.BalloonValueSets
                        ' Set balloon value from browser.
                        oBalloonValueSet.OverrideValue = occurrence.Name
                    Next 'go to next balloon
                Catch'do nothing if error
                End Try
            End If 'end of search for Tags balloons
        Next
    Next
End If
 
'----------End Update existing balloons on all sheets
 


Try this out, and customizing for your needs.  Let me know how that goes for you.
ADS.

No comments:

Post a Comment