Lesson 6.2 - find faces

Files

Lesson 6.2 - find faces

Code

'Find the two largest planar faces
'If getting strange results, restart SolidWorks
    
Option Explicit
    
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swBody As SldWorks.Body2
Dim swFace As SldWorks.Face2
Dim swSurf As SldWorks.Surface
Dim vBodies As Variant
Dim vFaces As Variant
Dim swFinalFaces(1) As SldWorks.Face2
Dim swEnt As SldWorks.Entity
Dim i As Integer
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swPart = swModel
    vBodies = swPart.GetBodies2(swSolidBody, False)
    Set swBody = vBodies(0)
    vFaces = swBody.GetFaces
    For i = 0 To UBound(vFaces)
        Set swFace = vFaces(i)
        Set swSurf = swFace.GetSurface
        If swSurf.IsPlane Then
            If swFinalFaces(0) Is Nothing Then
                Set swFinalFaces(0) = swFace
                Set swFinalFaces(1) = swFace
            End If
            If swFace.GetArea > swFinalFaces(0).GetArea Then
                Set swFinalFaces(1) = swFinalFaces(0)
                Set swFinalFaces(0) = swFace
            ElseIf swFace.GetArea > swFinalFaces(1).GetArea Then
                Set swFinalFaces(1) = swFace
            End If
        End If
    Next i
    
    Set swEnt = swFinalFaces(0)
    Debug.Print Round(swFinalFaces(0).GetArea, 7)
    swEnt.Select4 False, Nothing
    Set swEnt = swFinalFaces(1)
    Debug.Print Round(swFinalFaces(1).GetArea, 7)
    swEnt.Select4 True, Nothing
    
    'These aren't being set to nothing automatically when macro ends, for some reason
    Set swFinalFaces(0) = Nothing
    Set swFinalFaces(1) = Nothing
End Sub