Get Length of Spline or Elliptical Edge Example (VBA)

This example shows how to get the length of an edge using display tessellation.

'-------------------------------------------------------------------
' Preconditions:
' 1. Open a part that contains a spline or elliptical edge.
' 2. Select the spline or elliptical edge.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Creates two 3D sketches:
'    * Control Pts contains control points for the edge.
'    * Spline Pts contains spline points for the edge.
' 2. Examine the graphics area, FeatureManager design tree,
'    the Immediate window.
'
' NOTE: A sketch with spline points is only created for a spline edge.
'-------------------------------------------------------------------

Option Explicit

'  Tolerances that the user can set using IModeler::SetTolerances

Public Enum swTolerances_e
    swBSCurveOutputTol = 0  ' 3D bspline curve output tolerance (meters)
    swBSCurveNonRationalOutputTol = 1  ' 3D non-rational bspline curve output tolerance (meters)
    swUVCurveOutputTol = 2  ' 2D trim curve output tolerance (fraction of characteristic min. face dimension)
    swSurfChordTessellationTol = 3  ' Chord tolerance or deviation for tessellation for surfaces
    swSurfAngularTessellationTol = 4  ' Angular tolerance or deviation for tessellation for surfaces
    swCurveChordTessellationTol = 5  ' Chord tolerance or deviation for tessellation for curves
End Enum

Public Enum swCurveTypes_e
    LINE_TYPE = 3001
    CIRCLE_TYPE = 3002
    ELLIPSE_TYPE = 3003
    INTERSECTION_TYPE = 3004
    BCURVE_TYPE = 3005
    SPCURVE_TYPE = 3006
    CONSTPARAM_TYPE = 3008
    TRIMMED_TYPE = 3009
End Enum

' Define two types
Type DoubleRec
    dValue As Double
End Type

Type Long2Rec
    iLower As Long ' Assuming that a C int has 4 bytes
    iUpper As Long
End Type

' Extract two integer values out of a single double value,
' by assigning a DoubleRec to the double value and then
' copying the value over an Long2Rec and
' extracting the integer values
Function ExtractFields(ByVal dValue As Double, iLower As Integer, iUpper As Integer)
    Dim dr As DoubleRec
    Dim i2r As Long2Rec

    ' Set the double value
    dr.dValue = dValue

    ' Copy the values
    LSet i2r = dr

    ' Extract the values
    iLower = i2r.iLower
    iUpper = i2r.iUpper

End Function

Sub ProcessModellerSettings(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swModeller As SldWorks.Modeler)

    ' Process modeler settings
    Debug.Print "Modeler Settings:"
    Debug.Print "  BSCurveOutputTol                 = " & swModeller.GetToleranceValue(swBSCurveOutputTol)
    Debug.Print "  BSCurveNonRationalOutputTol      = " & swModeller.GetToleranceValue(swBSCurveNonRationalOutputTol)
    Debug.Print "  UVCurveOutputTol                 = " & swModeller.GetToleranceValue(swUVCurveOutputTol)
    Debug.Print "  SurfChordTessellationTol         = " & swModeller.GetToleranceValue(swSurfChordTessellationTol)
    Debug.Print "  SurfAngularTessellationTol       = " & swModeller.GetToleranceValue(swSurfAngularTessellationTol)
    Debug.Print "  CurveChordTessellationTol        = " & swModeller.GetToleranceValue(swCurveChordTessellationTol)
    Debug.Print ""

End Sub

Sub ProcessBCurveInfo(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vBCurveParam As Variant)

    Dim nDim As Integer
    Dim nOrder As Integer
    Dim nCtrlPoints As Integer
    Dim nPeriodicity As Integer
    Dim nNumKnots As Integer
    Dim swSketch As SldWorks.Sketch
    Dim swSkFeat As SldWorks.Feature
    Dim swSkPt As SldWorks.SketchPoint
    Dim i As Integer

    ExtractFields vBCurveParam(0), nDim, nOrder
    ExtractFields vBCurveParam(1), nCtrlPoints, nPeriodicity
    nNumKnots = nOrder + nCtrlPoints

    Debug.Print "  Dimension        = " & nDim
    Debug.Print "  Order            = " & nOrder
    Debug.Print "  Num Ctrl Pts     = " & nCtrlPoints
    Debug.Print "  Periodicity      = " & nPeriodicity
    Debug.Print "  Num Knots        = " & nNumKnots
    Debug.Print ""

    For i = 0 To nNumKnots - 1
        ' Knot weights should be increasing monotonically
        Debug.Print "  Knot(" & i & ")          = " & vBCurveParam(2 + i)
    Next i

    Debug.Print ""

    swModel.Insert3DSketch2 False
    swModel.SetAddToDB True
    swModel.SetDisplayWhenAdded False

    Set swSketch = swModel.GetActiveSketch2
    Set swSkFeat = swSketch

    If 3 = nDim Then

        For i = 2 + nNumKnots To UBound(vBCurveParam) - 1 Step 3

            Debug.Print "  Ctrl(" & (i - 2 - nNumKnots) / 3 & ")          = (" & vBCurveParam(i + 0) * 1000# & ", " & vBCurveParam(i + 1) * 1000# & ", " & vBCurveParam(i + 2) * 1000# & ") mm"
            Set swSkPt = swModel.CreatePoint2(vBCurveParam(i + 0), vBCurveParam(i + 1), vBCurveParam(i + 2))
        Next i
    Else
        For i = 2 + nNumKnots To UBound(vBCurveParam) - 1 Step 4
            Debug.Print "  Ctrl(" & (i - 2 - nNumKnots) / 4 & ")          = (" & vBCurveParam(i + 0) * 1000# & ", " & vBCurveParam(i + 1) * 1000# & ", " & vBCurveParam(i + 2) * 1000# & ") mm [" & vBCurveParam(i + 3) & "]"
            Set swSkPt = swModel.CreatePoint2(vBCurveParam(i + 0), vBCurveParam(i + 1), vBCurveParam(i + 2))
       Next i
    End If

    swModel.SetDisplayWhenAdded True
    swModel.SetAddToDB False
    swModel.Insert3DSketch2 True

    swModel.ClearSelection2 True

    swSkFeat.Name = "Control Pts"

End Sub

Sub ProcessSplineInfo(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, vSplinePts As Variant)
    Dim swSketch As SldWorks.Sketch
    Dim swSkFeat As SldWorks.Feature
    Dim swSkPt As SldWorks.SketchPoint
    Dim i As Long

    swModel.Insert3DSketch2 False
    swModel.SetAddToDB True
    swModel.SetDisplayWhenAdded False

    Set swSketch = swModel.GetActiveSketch2
    Set swSkFeat = swSketch

    For i = 0 To UBound(vSplinePts) Step 3
        Debug.Print "  SplinePt(" & i / 3 & ")     = (" & vSplinePts(i + 0) * 1000# & ", " & vSplinePts(i + 1) * 1000# & ", " & vSplinePts(i + 2) * 1000# & ") mm"
        Set swSkPt = swModel.CreatePoint2(vSplinePts(i + 0), vSplinePts(i + 1), vSplinePts(i + 2))
    Next i

    swModel.SetDisplayWhenAdded True
    swModel.SetAddToDB False
    swModel.Insert3DSketch2 True

    swModel.ClearSelection2 True

    swSkFeat.Name = "Spline Pts"

End Sub

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModeller As SldWorks.Modeler
    Dim swModel As SldWorks.ModelDoc2
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swEdge As SldWorks.Edge
    Dim swCurve As SldWorks.Curve
    Dim vBCurveParam As Variant
    Dim vSplinePts As Variant
    Dim i As Long
    Dim bRet As Boolean
    

    Set swApp = Application.SldWorks
    Set swModeller = swApp.GetModeler
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swEdge = swSelMgr.GetSelectedObject5(1)
    Set swCurve = swEdge.GetCurve: Debug.Assert swCurve.IsBcurve
    ProcessModellerSettings swApp, swModel, swModeller
    vBCurveParam = swCurve.GetBCurveParams(False)
    vSplinePts = swCurve.GetSplinePts(vBCurveParam)

    Debug.Print "File = " & swModel.GetPathName
    Debug.Print "  Identity         = " & swCurve.Identity

    ProcessBCurveInfo swApp, swModel, vBCurveParam

    Debug.Print "  "

    ' Do not assert because null is a valid return value
    '   ICurve::GetSplinePts
    '       *  If the curve is periodic, then it must not have any repeated knots.
    '       *  If the curve is non-periodic, it must only have repeated
    '          knots at its ends.    
    '
    '       The curve must be cubic or lower degree, non-rational, and
    '           have continuous first and second derivatives.
    '
    '       NOTE: For a linear or quadratic curve to satisfy these continuity
    '       requirements, it must consist of a single segment.

    If Not IsNull(vSplinePts) Then
        ProcessSplineInfo swApp, swModel, vSplinePts
        Debug.Print " "

    End If

End Sub