Sketched Symbol with Leader to Dimension

Sketched Symbol with Leader to Dimension

wannensn
Enthusiast Enthusiast
659 Views
0 Replies
Message 1 of 1

Sketched Symbol with Leader to Dimension

wannensn
Enthusiast
Enthusiast

Hello,

 

I'm using the following code to create a sketched symbol and link it with a leader to a dimension. It is working for most dimensions but not all especcially radius dimension (screenshot) which are not orientated vertical or horizontal don't work. I suspect that the 'IntentPoint' is the problem, but I don't know why.

 

 'get reference to the drawing document
        Dim tmpDrawingDocument As Inventor.DrawingDocument
        tmpDrawingDocument = mInventorApplication.ActiveDocument

        Dim tmpTransientGeometry As Inventor.TransientGeometry
        tmpTransientGeometry = mInventorApplication.TransientGeometry

        Dim tmpSheet As Inventor.Sheet
        tmpSheet = tmpDrawingDocument.ActiveSheet

        'create a new sketched symbol definition
        Dim tmpSketchedSymbolDefintion As Inventor.SketchedSymbolDefinition = Nothing
        Try
            tmpSketchedSymbolDefintion = tmpDrawingDocument.SketchedSymbolDefinitions.Item("TEST01")
        Catch ex As Exception
        End Try

        If tmpSketchedSymbolDefintion Is Nothing Then
            tmpSketchedSymbolDefintion = tmpDrawingDocument.SketchedSymbolDefinitions.Add("TEST01")

            'open the sketch of the sketched symbol definition
            Dim tmpSketch As Inventor.DrawingSketch
            tmpSketchedSymbolDefintion.Edit(tmpSketch)

            'create circle
            Dim tmpCircle As Inventor.SketchCircle
            tmpCircle = tmpSketch.SketchCircles.AddByCenterRadius(tmpTransientGeometry.CreatePoint2d(0, 0), STAMP_RADIUS)

            'define connection and insertion point
            tmpCircle.CenterSketchPoint.ConnectionPoint = True
            tmpCircle.CenterSketchPoint.InsertionPoint = True

            'finish edit mode and save changes
            tmpSketchedSymbolDefintion.ExitEdit(True)
        End If

        Dim tmpCurrentSelectSet As Inventor.SelectSet
        Dim tmpDimension As Inventor.DrawingDimension
        Dim tmpObject As Object
        Dim i As Integer

        tmpCurrentSelectSet = mInventorApplication.ActiveDocument.SelectSet

        If tmpCurrentSelectSet.Count > 0 Then
            For i = 1 To tmpCurrentSelectSet.Count Step 1
                tmpObject = tmpCurrentSelectSet.Item(i)
                If TypeOf tmpObject Is Inventor.DrawingDimension Then
                    tmpDimension = tmpObject

                    Dim tmpSketchedSymbol As Inventor.SketchedSymbol

                    'create leaderpoints
                    Dim tmpLeaderPoints As Inventor.ObjectCollection
                    Dim tmpLeaderPoint As Inventor.Point2d
                    Dim tmpX, tmpY As Double

                    tmpX = tmpDimension.Text.RangeBox.MaxPoint.X
                    tmpY = tmpDimension.Text.RangeBox.MinPoint.Y


                    tmpLeaderPoints = mInventorApplication.TransientObjects.CreateObjectCollection
                    tmpLeaderPoint = tmpTransientGeometry.CreatePoint2d(tmpX + 1, tmpY + 1)

                    tmpLeaderPoints.Add(tmpLeaderPoint)

                    Dim tmpGeometryIntent As Inventor.GeometryIntent
                    Dim tmpIntentPoint As Inventor.Point2d
                    tmpIntentPoint = tmpTransientGeometry.CreatePoint2d(tmpX, tmpY)
                    tmpGeometryIntent = tmpSheet.CreateGeometryIntent(tmpDimension, tmpIntentPoint)
                    tmpLeaderPoints.Add(tmpGeometryIntent)

                    'create the new sketched symbol
                    Try
                        tmpSketchedSymbol = tmpSheet.SketchedSymbols.AddWithLeader(tmpSketchedSymbolDefintion, tmpLeaderPoints, 0, 1, Nothing, True, True)
                        tmpSketchedSymbol.LeaderVisible = False
                    Catch ex As Exception
                    End Try

                    tmpSketchedSymbol.Static = True
                End If
            Next
        End If

 

Regards, Stephan

0 Likes
660 Views
0 Replies
Replies (0)