Get Data for Surface-flatten Feature Example (VBA)

This example shows how to insert a surface-flatten feature and get its data.

'-------------------------------------------------------
' Preconditions:
' 1. Verify that the part to open exists.
' 2. Open the Immediate window.
'
' Postconditions:
' 1. Opens the part.
' 2. Inserts a surface-flatten feature.
' 3. Gets surface-flatten feature data.
' 4. Examine the graphics area and FeatureManager design
'    tree.
'
' NOTE: Because this part is used elsewhere, do not save
' changes.
'--------------------------------------------------------
Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swFeatureManager As SldWorks.FeatureManager
Dim swFeature As SldWorks.Feature
Dim swSurfaceFlattenFeatureData As SldWorks.SurfaceFlattenFeatureData
Dim swEdge As SldWorks.Edge
Dim status As Boolean
Dim warnings As Long
Dim errors As Long
Dim fileName As String
Dim edges As Variant
Dim nbrTearEdges As Long
Dim i As Long

Sub main()

    Set swApp = Application.SldWorks
    fileName = "C:\Program Files\SolidWorks Corp\SOLIDWORKS\samples\tutorial\api\Hemisphere.SLDPRT"
    Set swModel = swApp.OpenDoc6(fileName, swDocumentTypes_e.swDocPART, swOpenDocOptions_e.swOpenDocOptions_Silent, "", errors, warnings)
    Set swModelDocExt = swModel.Extension

    ' Select face, point, and curves for surface-flatten feature
    status = swModelDocExt.SelectByID2("", "FACE", 5.46207138008786E-03, -3.73996629648742E-02, 1.30049636270216E-02, False, 1, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "VERTEX", 0, -4.00014251170795E-02, -5.4185036618795E-04, True, 16, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 0.011047389592717, -6.23453597697887E-06, 3.82739927527045E-02, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 1.08290857690036E-02, -2.62767618508641E-02, 2.80128973987478E-02, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 9.07918330954303E-03, 2.86363967873063E-02, 2.62553195430037E-02, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 1.57595492108076E-02, 2.40950142317162E-02, -2.72880335909787E-02, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 1.43808110794609E-02, -2.81074423709366E-02, -2.40578702886196E-02, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 0.01886657492451, 2.48139106812095E-05, -0.035004838468241, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 1.40143161426676E-02, -3.74399859522778E-02, 1.23652313243445E-04, True, 8, Nothing, 0)
    status = swModelDocExt.SelectByID2("", "EDGE", 1.64192327552536E-02, 3.63245554251959E-02, -9.58561062339106E-05, True, 8, Nothing, 0)

    ' Create surface-flatten feature
    Set swFeatureManager = swModel.FeatureManager
    Set swFeature = swFeatureManager.InsertFlattenSurface2(8, True)
    

    ' Get surface-flatten feature data
    Set swSurfaceFlattenFeatureData = swFeature.GetDefinition
    swSurfaceFlattenFeatureData.AccessSelections swModel, Nothing
    Debug.Print "Feature = " & swFeature.Name
    Debug.Print "   Accuracy of flattened triangle mesh =  " & swSurfaceFlattenFeatureData.AccuracyFactor
    Debug.Print "   Keep internal control curves? " & swSurfaceFlattenFeatureData.KeepInternalControlCurves
    If swSurfaceFlattenFeatureData.ShouldMakeTears = True Then
        Debug.Print "   Tear edges: "
        edges = swSurfaceFlattenFeatureData.TearEdges
        nbrTearEdges = UBound(edges) + 1
        Debug.Print "      Number of tear edges: " & nbrTearEdges
        For i = 0 To UBound(edges)
            Set swEdge = edges(i)
            Dim swSelMgr As SldWorks.SelectionMgr
            Set swSelMgr = swModel.SelectionManager
            status = swSelMgr.AddSelectionListObject(swEdge, Nothing)
            Debug.Print "            Type of object (51 = swSelREFEDGES): " & swSelMgr.GetSelectedObjectType3(1, -1)
        Next i
    End If
    swSurfaceFlattenFeatureData.ReleaseSelectionAccess    

End Sub