Macro to create ISO curves for face using SOLIDWORKS API

{ width=300 }

This example demonstrates how to find specified number of iso-curves in the u and v bounds of the selected face using SOLIDWORKS API.

• Select the face and run the macro
• Iso curves are previewed and macro execution stops
• Continue the macro to clear the preview

Number of iso curves in u and v direction can be changed in the following snippet

Dim vCurves As Variant
vCurves = GetIsoCurves(swFace, <Number of curves in u direction>, <Number of curves in v direction>)

Optionally macro allows to create curves in the 3D Sketch.

{ width=300 }

This option can be enabled by setting CREATE_SKETCH constant to True at the beginning of the macro:

Const CREATE_SKETCH As Boolean = True

Macro:

Const CREATE_SKETCH As Boolean = False

Dim swApp As SldWorks.SldWorks

Sub main()

    Set swApp = Application.SldWorks
    
    Dim swModel As SldWorks.ModelDoc2
    
    Set swModel = swApp.ActiveDoc
    
    If Not swModel Is Nothing Then
    
        Dim swSelMgr As SldWorks.SelectionMgr
        
        Set swSelMgr = swModel.SelectionManager
        
        Dim swFace As SldWorks.Face2
        Set swFace = swSelMgr.GetSelectedObject6(1, -1)
        
        If Not swFace Is Nothing Then
            
            Dim vCurves As Variant
            vCurves = GetIsoCurves(swFace, 10, 10)
            
            If True = CREATE_SKETCH Then
                DrawCurves swModel, vCurves, 0.001, 0.001
            Else
                PreviewCurves swModel, vCurves
            End If
            
        Else
            MsgBox "Please select face"
        End If
    
    Else
        MsgBox "Please open the model"
    End If
    
End Sub

Function GetIsoCurves(face As SldWorks.Face2, uCount As Integer, vCount As Integer) As Variant
    
    Dim swCurves() As SldWorks.curve
    ReDim swCurves(uCount + vCount - 1)
    
    Dim uCurves As Variant
    Dim vCurves As Variant
    
    uCurves = SplitFaceOnIsoCurves(face, True, uCount)
    vCurves = SplitFaceOnIsoCurves(face, False, vCount)
    
    Dim i As Integer
    
    For i = 0 To UBound(uCurves)
        Set swCurves(i) = uCurves(i)
    Next
    
    For i = 0 To UBound(vCurves)
        Set swCurves(UBound(uCurves) + 1 + i) = vCurves(i)
    Next
    
    GetIsoCurves = swCurves
    
End Function

Function SplitFaceOnIsoCurves(face As SldWorks.Face2, UorV As Boolean, count As Integer) As Variant

    Dim swCurves() As SldWorks.curve
    ReDim swCurves(count - 1)
    
    Dim swSurf As SldWorks.Surface
    Set swSurf = face.GetSurface
    
    Dim thisParamMin As Double
    Dim thisParamMax As Double
    Dim otherParamMin As Double
    Dim otherParamMax As Double
    
    Dim vUvBounds As Variant
    vUvBounds = face.GetUVBounds
    
    If True = UorV Then
        thisParamMin = vUvBounds(0)
        thisParamMax = vUvBounds(1)
        otherParamMin = vUvBounds(2)
        otherParamMax = vUvBounds(3)
    Else
        thisParamMin = vUvBounds(2)
        thisParamMax = vUvBounds(3)
        otherParamMin = vUvBounds(0)
        otherParamMax = vUvBounds(1)
    End If
    
    Dim i As Integer
    
    Dim paramStep As Double
    paramStep = (thisParamMax - thisParamMin) / (count - 1)
    
    For i = 0 To count - 1
        
        Dim param As Double
        param = thisParamMin + i * paramStep
        
        Dim swCurve As SldWorks.curve
        Set swCurve = swSurf.MakeIsoCurve2(Not UorV, param)
        
        Dim u As Double
        Dim v As Double
        
        Dim vStartPt As Variant
        Dim vEndPt As Variant
        
        If True = UorV Then
            u = param
            v = otherParamMin
        Else
            v = param
            u = otherParamMin
        End If
        
        vStartPt = swSurf.Evaluate(u, v, 0, 0)
        
        If True = UorV Then
            u = param
            v = otherParamMax
        Else
            v = param
            u = otherParamMax
        End If
        
        vEndPt = swSurf.Evaluate(u, v, 0, 0)
        
        Set swCurve = swCurve.CreateTrimmedCurve2(vStartPt(0), vStartPt(1), vStartPt(2), vEndPt(0), vEndPt(1), vEndPt(2))
        Set swCurves(i) = swCurve
    Next
    
    SplitFaceOnIsoCurves = swCurves
    
End Function

Sub PreviewCurves(model As SldWorks.ModelDoc2, curves As Variant)
    
    Dim swModeler As SldWorks.Modeler
    Set swModeler = swApp.GetModeler
    
    Dim swCurvesBody() As SldWorks.Body2
    
    ReDim swCurvesBody(UBound(curves))
    
    Dim i As Integer
        
    For i = 0 To UBound(curves)
        Dim swCurve As SldWorks.curve
        Set swCurve = curves(i).MakeBsplineCurve2()
        Set swCurvesBody(i) = swCurve.CreateWireBody
        swCurvesBody(i).Display3 model, RGB(255, 255, 0), swTempBodySelectOptions_e.swTempBodySelectOptionNone
    Next
    
    Stop
    
    'clear preview
    For i = 0 To UBound(swCurvesBody)
        Set swCurvesBody(i) = Nothing
    Next
        
    model.GraphicsRedraw2
    
End Sub

Sub DrawCurves(model As SldWorks.ModelDoc2, curves As Variant, chordTol As Double, lengthTol As Double)
    
    Dim swSketchMgr As SldWorks.SketchManager
    Set swSketchMgr = model.SketchManager
    
    model.ClearSelection2 True
    swSketchMgr.Insert3DSketch False
    model.SetAddToDB True
        
    For i = 0 To UBound(curves)
        Dim swCurve As SldWorks.curve
        Set swCurve = curves(i)
        DrawCurve swCurve, model, chordTol, lengthTol
    Next
    
    model.SetAddToDB False
    swSketchMgr.Insert3DSketch True
        
End Sub

Sub DrawCurve(curve As SldWorks.curve, model As SldWorks.ModelDoc2, chordTol As Double, lengthTol As Double)

    Dim vStartPt As Variant
    Dim vEndPt As Variant
    Dim vTessPts As Variant
    
    Dim startParam As Double
    Dim endParam As Double
    
    curve.GetEndParams startParam, endParam, False, False
    
    vStartPt = curve.Evaluate2(startParam, 0)
    vEndPt = curve.Evaluate2(endParam, 0)

    vTessPts = curve.GetTessPts(chordTol, lengthTol, (vStartPt), (vEndPt))

    For i = 0 To UBound(vTessPts) - 3 Step 3
        model.CreateLine2 vTessPts(i + 0), vTessPts(i + 1), vTessPts(i + 2), vTessPts(i + 3), vTessPts(i + 4), vTessPts(i + 5)
    Next i

End Sub