' ******************************************************************************
' Tessliert alle Flächen des Bauteils als 3D-Skizze
' ******************************************************************************

Option Explicit

Public Enum swWindowState_e
    swWindowNormal = 0
    swWindowMaximized = 1
    swWindowMinimized = 2
End Enum

Sub main()
    Dim swApp                   As SldWorks.SldWorks
    Dim swModel                 As SldWorks.ModelDoc2
    Dim swPart                  As SldWorks.PartDoc
    Dim swModView               As SldWorks.ModelView
    Dim swBody                  As SldWorks.Body2
    Dim swSelMgr                As SldWorks.SelectionMgr
    Dim swFace                  As SldWorks.Face2
    Dim swFaceArr()             As SldWorks.Face2
    Dim vBodies                 As Variant
    Dim vFaceArray              As Variant
    Dim swTess                  As SldWorks.Tessellation
    Dim vFacetId                As Variant
    Dim vFinId                  As Variant
    Dim vVertexId               As Variant
    Dim vVertex1                As Variant
    Dim vVertex2                As Variant
    Dim vNormals                As Variant
    Dim vErrorList              As Variant
    Dim vFaceErrArray           As Variant
    Dim vFacetErrArray          As Variant
    Dim vVertexPointErrArray    As Variant
    Dim vVertexNormalErrArray   As Variant
    Dim vVertexParamsErrArray   As Variant
    Dim vTessNorms              As Variant
    Dim i                       As Long
    Dim j                       As Long
    Dim iNumFacets              As Long
    Dim iNegNormals             As Long
    Dim bRet                    As Boolean
    Dim iAngleTol               As Double
    Dim iCount                  As Long
    
    Set swApp = CreateObject("SldWorks.Application")
    Set swModel = swApp.ActiveDoc
    Set swModView = swModel.ActiveView
    Set swPart = swModel
    
    ReDim swFaceArr(0)
    
    vBodies = swPart.GetBodies2(swAllBodies, True)
    Set swBody = vBodies(0)
    Set swFace = swBody.GetFirstFace
    
   
    ' add sketch for this face
    swModel.Insert3DSketch2 False
        
    'swModel.SetDisplayWhenAdded False
        
    ' add lines directly to sketch to
    ' increase performance
    swModel.SetAddToDB True
    
    Set swFaceArr(0) = swFace
    'swFaceArr(UBound(swFaceArr)) = swFace
    
    Set swTess = swBody.GetTessellation(vFaceArray)
        
    swTess.NeedFaceFacetMap = True
    swTess.NeedVertexNormal = True
    swTess.NeedErrorList = True
    swTess.NeedEdgeFinMap = True
    swTess.NeedVertexParams = True
        
    'CurveChordAngleTolerance in degree
    iAngleTol = 10
        
    swTess.CurveChordAngleTolerance = Radiant(iAngleTol)
    swTess.CurveChordTolerance = 0.02 / 1000
    ' dump tessellation settings
    'Debug.Print "CurveChordAngleTol         = " + Str(swTess.CurveChordAngleTolerance)
    'Debug.Print "CurveChordTol              = " + Str(swTess.CurveChordTolerance)
    'Debug.Print "MaxFacetWidth              = " + Str(swTess.MaxFacetWidth)
    'Debug.Print "MinFacetWidth              = " + Str(swTess.MinFacetWidth)
    'Debug.Print "SurfacePlaneAngleTol       = " + Str(swTess.SurfacePlaneAngleTolerance)
    'Debug.Print "SurfacePlaneTol            = " + Str(swTess.SurfacePlaneTolerance)
    'Debug.Print "NeedEdgeFinMap             = " + Str(swTess.NeedEdgeFinMap)
    'Debug.Print "NeedErrorList              = " + Str(swTess.NeedErrorList)
    'Debug.Print "NeedFaceFacetMap           = " + Str(swTess.NeedFaceFacetMap)
    'Debug.Print "NeedVertexNormal           = " + Str(swTess.NeedVertexNormal)
    'Debug.Print "NeedVertexParams           = " + Str(swTess.NeedVertexParams)
        
    bRet = swTess.Tessellate
    
    'vErrorList = swTess.GetErrorList(vFaceErrArray, vFacetErrArray, vVertexPointErrArray, vVertexNormalErrArray, vVertexParamsErrArray)
        
    iNumFacets = swTess.GetFacetCount()
        
    Do While Not swFace Is Nothing
        
        vTessNorms = swFace.GetTessNorms()
        
        vFacetId = swTess.GetFaceFacets(swFace)
                
        For i = 0 To UBound(vFacetId)
            
            vNormals = swTess.GetVertexNormal(vFacetId(i))
            If VarType(vNormals) = 0 Then
                iCount = iCount + 1
                GoTo Sprungmarke
            End If
            
            If vNormals(2) < 0 Then
                iNegNormals = iNegNormals + 1
            End If
            
Sprungmarke:
            
            vFinId = swTess.GetFacetFins(vFacetId(i))
            For j = 0 To 2
                ' should always be 3 fins per facet
                vVertexId = swTess.GetFinVertices(vFinId(j))
                    
                ' should always be two vertices per fin
                vVertex1 = swTess.GetVertexPoint(vVertexId(0))
                vVertex2 = swTess.GetVertexPoint(vVertexId(1))
            
                Call swModel.CreateLine2( _
                    vVertex1(0), vVertex1(1), vVertex1(2), _
                    vVertex2(0), vVertex2(1), vVertex2(2))
            Next j
        Next i
     
        Set swFace = swFace.GetNextFace
    
    Loop
       
    ' turn snapping back on
    swModel.SetAddToDB False
    
    ' exit sketch
    swModel.Insert3DSketch2 True
    
    swModel.ClearSelection2 True
    
    'swModel.SetDisplayWhenAdded (True)
    
    Debug.Print "Anzahl der Dreiecke: " & iNumFacets
    Debug.Print "Anzahl der Normalenvektoren mit neg. z-Komp.: " & iNegNormals
    Debug.Print "Anzahl der übersprungenen Dreiecke: " & iCount

End Sub

Public Function Radiant(dAngle As Double) As Double
    Dim Pi  As Double
    
    Pi = 4 * Atn(1)
    Radiant = dAngle * Pi / 180
    
End Function

' ******************************************************************************