REPOS_ERICCA/magicsld/PoGCode.vb

Imports System
Imports System.IO
Module PoGCode
    Private TabPoints(,) As Double
    Private tabpointsface() As SldWorks.Face2
    Private tabpointsedge() As SldWorks.Edge
    Private tabpointsVertex() As SldWorks.Vertex
    Private Tabface() As SldWorks.Face2
    Private TabVertex(,) As Double
    Private TabVertexDouble(,) As Double
    Private TabFaceDouble(,) As Double
    Private TabEdgeDouble(,) As Double
    Private TabEdge() As SldWorks.Edge
    Private cptVertex As Long
    Private cpt As Long
    Private vBodies As Object
    Private swbody As SldWorks.Body2
    Private Class retrait_mat
        Public face As SldWorks.Face2
        Public diametre As Double
        Public Sub New(ByRef fac As SldWorks.Face2, ByVal diam As Double)
            face = fac
            diametre = diam
        End Sub
    End Class
    Private Tabretrait_mat() As retrait_mat
 

    'le programme fonction de la manière suivante :
    '  -    on va tout d'abord initialiser toutes les entités du modèle comme
    '       ayant un coefficient de raffinement de maillage = 1
    '  -    Ensuite on va utiliser les algorithmes de detections des caractéristiques de forme
    '       le coefficient de raffinement de maillage de chaque entité repérée est changé
    '  -    on créée ensuite les points d'échantillonnage en commencant par les sommets repérés
    '       puis les arêtes puis les faces.
    '  -    La grille vérifie que qu'on ne place pas trop de points d'échantillonnage et
    '       elle est initialisée sur la boite englobante du modèle
    '  -    Si l'utilisateur la préciser on génère des points d'échantillonnage dans le volume
    '       la fonction functionvolume permet de rajouter ou de modifier la fonctionnelle de répartition
    '  -    Tous les points d'échantillonnage créés se retrouvent dans "tabpoint" 
    '       on écrit le fichier des points d'échantillonnage à partir de se tableau

    Public Function DebutManuel(ByVal Eng As Double, ByVal NbCouches As Integer, ByVal ArrondiBool As Boolean, ByVal Arrondis As Double, ByVal rentrantBool As Boolean, ByVal rentrant As Double, ByVal matiereBool As Boolean, ByVal matiere As Double, ByVal entitésbool As Boolean, ByVal entités As SldWorks.PropertyManagerPageSelectionbox, ByVal Entities As Double, ByVal RaffInd As Boolean) As String
        Dim frequence As Integer
        Dim vbody As Object
        Dim grill As New grille
        Dim Bbox() As Double
        Dim path As String
        Dim erx_rm As Double


        Dim CMDialogl As New Windows.Forms.SaveFileDialog
        CMDialogl.DefaultExt = ".txt"
        CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"

        CMDialogl.OverwritePrompt = True
        CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
        CMDialogl.ShowDialog()
        path = CMDialogl.FileName
        path = Txtpath(path)
        If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!") : Return ""

        'MsgBox("Début de la routine de pré-optimisation" & vbCr & vbCr & "l'écart nodal global est de : " & Eng & vbCr & "La zone de transition : " & NbCouches & vbCr & "Les arrondis sont à : " & Arrondis & vbCr & "Arretes rentrantes: " & rentrant & vbCr & "Les retraits matière: " & matiere & vbCr & vbCr & "Arrondi = " & ArrondiBool & vbCr & "Rentrant = " & rentrantBool & vbCr & "Matiere = " & matiereBool)
        vBodies = swPart.GetBodies2(SwConst.swBodyType_e.swAllBodies, True)
        For Each vbody In vBodies
            cpt = 0
            Erase TabPoints
            Erase Tabface
            Erase TabFaceDouble
            Erase TabEdge
            Erase TabEdgeDouble

            swbody = vbody
            BoiteEnglobante()
            initialisation()

            'initialistation de la grille
            Dim Coeffmax As Double = Math.Max(Math.Max(Arrondis, matiere), Math.Max(rentrant, Entities))
            Dim taillecase As Double = Eng * (1 - Coeffmax)
            Bbox = swbody.GetBodyBox
            ' on initialise la grille 0.5 pourcent supérieur à la bounding box
            grill.initialiser(Bbox(0) - (Bbox(3) - Bbox(0)) * 0.005, Bbox(1) - (Bbox(4) - Bbox(1)) * 0.005, Bbox(2) - (Bbox(5) - Bbox(2)) * 0.005, Bbox(3) + (Bbox(3) - Bbox(0)) * 0.005, Bbox(4) + (Bbox(4) - Bbox(1)) * 0.005, Bbox(5) + (Bbox(5) - Bbox(2)) * 0.005, Int((Bbox(3) - Bbox(0) + 2 * (Bbox(3) - Bbox(0)) * 0.005) / taillecase), Int((Bbox(4) - Bbox(1) + 2 * (Bbox(4) - Bbox(1)) * 0.005) / taillecase), Int((Bbox(5) - Bbox(2) + 2 * (Bbox(5) - Bbox(2)) * 0.005) / taillecase))

            ' si la case arrondis est cochée
            If ArrondiBool = True Then
                testArrondis(Arrondis) 'i * 0.1) 
            End If
            ' Si la case retrait matiere est cochée
            If matiereBool = True Then
                erx_rm = determination_precision_retrait_mat(Eng, matiere)
                raffinement_retrait_matiere(Eng, erx_rm)
                'testretraitMatiere(Eng, erx_rm)
            End If
            ' si la case rentrant est cochée
            If rentrantBool = True Then
                testAngleMatiere(rentrant)
            End If
            ' si la case entités est cochée
            If entitésbool = True Then
                If Enregistrement.selectionpog.GetSelectionFocus = True Then
                    entitéselection(Entities, RaffInd)
                End If
            End If
            ' on crée les points d'échantillonnage sur les sommets
            CreerPointsVertex(Eng, grill)
            ' on crée les points d'échantillonnage sur les arêtes
            CreerPointsEdge(Eng, grill)
            ' on crée les points d'échantillonnage sur les faces
            CreerPointsFace(Eng, grill)

            If NbCouches <> 0 Then
                CreerPointsVolume(Eng, NbCouches, grill)
            End If
            ' on crée les points d'échantillonnage dans le volume

            'Remarque, selon l'ordre, on obtient pas le même fichier d'échantillonage
            ' on peut changé l'ordre selon la convenence de l'utilisateur

            ' on créée le fichier d'échantillonnage
            fichiertxt(Eng, path)
            swModel.ClearSelection2(True)
            testPog(False, False, False, True, False)
            Return path
        Next vbody

    End Function

    ''' <summary>
    ''' Function POur traiter la préoptimisation de façon automatique
    ''' </summary>
    ''' <param name="Erx">Premier paramètre</param>
    ''' <param name="LimPT">youjhou</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function DebutAutomatique(ByVal Erx As Double, ByVal LimPT As Double) As String

        MsgBox("Erx = " & Erx & vbCr & "Limite = " & LimPT)

        Return Nothing
    End Function

    Sub entitéselection(ByRef coeff As Double, ByRef Ind As Boolean)
        Dim swSelMgr As SldWorks.SelectionMgr
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim swvertex As SldWorks.Vertex
        Dim point() As Double
        Dim type As String
        Dim tabface() As SldWorks.Face2
        Dim SelfaceBool As Boolean = False
        Dim cptface As Integer = 0
        Dim selAreteBool As Boolean = False
        Dim tabArete() As SldWorks.Edge
        Dim cptarete As Integer = 0
        Dim selSommetBool As Boolean = False
        Dim tabSommet() As SldWorks.Vertex
        Dim cptsommet As Integer = 0
        

        swSelMgr = swModel.SelectionManager
        For i = 1 To swSelMgr.GetSelectedObjectCount
            swent = swSelMgr.GetSelectedObject5(i)
            type = swent.GetType
            Select Case type
                Case "2"
                    ReDim Preserve tabface(cptface)
                    tabface(cptface) = swent
                    cptface = cptface + 1
                    SelfaceBool = True
                Case "1"
                    ReDim Preserve tabArete(cptarete)
                    tabArete(cptarete) = swent
                    cptarete = cptarete + 1
                    selAreteBool = True
                Case "3"
                    ReDim Preserve tabSommet(cptsommet)
                    tabSommet(cptsommet) = swent
                    cptsommet = cptsommet + 1
                    selSommetBool = True
            End Select
        Next i
        swModel.ClearSelection2(True)

        If selSommetBool = True Then
            For i = 0 To UBound(tabSommet)
                swent = tabSommet(i)
                If Ind = True Then
                    coeff = InputBox("coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    While coeff < 0 Or coeff > 1
                        coeff = InputBox("le coefficient doit être compris entre 0 et 1 excluent" & "coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    End While
                End If
                swvertex = swent
                point = swvertex.GetPoint()
                ReDim Preserve TabVertex(2, cptVertex)
                ReDim Preserve TabVertexDouble(2, cptVertex)
                TabVertex(0, cptVertex) = point(0)
                TabVertex(1, cptVertex) = point(1)
                TabVertex(2, cptVertex) = point(2)
                TabVertexDouble(0, cptVertex) = coeff
                cptVertex = cptVertex + 1
            Next
        End If

        If selAreteBool = True Then
            For i = 0 To UBound(tabArete)
                swent = tabArete(i)
                swent.Select(False)
                If Ind = True Then
                    coeff = InputBox("coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    While coeff < 0 Or coeff > 1
                        coeff = InputBox("le coefficient doit être compris entre 0 et 1 excluent" & "coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    End While
                End If
                ChangeTabEdge(swent, coeff)
            Next
        End If

        If SelfaceBool = True Then
            For i = 0 To UBound(tabface)
                swent = tabface(i)
                swent.Select(False)
                If Ind = True Then
                    coeff = InputBox("coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    While coeff < 0 Or coeff > 1
                        coeff = InputBox("le coefficient doit être compris entre 0 et 1 excluent" & "coefficient de raffinement : ", "coefficient de raffinement", 0.1)
                    End While
                End If
                ChangeTabFace(swent, coeff)
            Next
        End If


    End Sub
    Sub test()
        Dim Actform As New pogtest
        Actform.Show()
    End Sub
    Public Sub testPog(ByRef a As Boolean, ByRef b As Boolean, ByRef c As Boolean, ByRef d As Boolean, ByRef e As Boolean)
        Dim vBodies As Object
        Dim vbody As Object
        Dim swbody As SldWorks.Body2
        Dim vBoundingBox() As Double
        Dim xmin, XMax, ymin, YMax, zmin, ZMax As Double
        Dim facecount As Integer
        Dim edgecount As Integer
        Dim vertexcount As Integer
        Dim cpt1 As Long
        Dim Cpt2 As Long
        Dim swent As SldWorks.Entity
        Dim swSelMgr As SldWorks.SelectionMgr
        Dim swSelData As SldWorks.SelectData

        If cpt = 0 Then
            If a = True Or b = True Or d = True Then
                MsgBox("pas de points d'échantillonnage")
            End If
        End If

        vBodies = swPart.GetBodies2(SwConst.swBodyType_e.swAllBodies, True)
        For Each vbody In vBodies
            swbody = vbody

            If a = True Then
                swSelMgr = swModel.SelectionManager
                swSelData = swSelMgr.CreateSelectData
                swModel.ClearSelection2(True)
                If cpt <> 0 Then
                    For cpt1 = 0 To UBound(Tabface)
                        If TabFaceDouble(0, cpt1) <> 1 Then
                            facecount = facecount + 1
                            swent = Tabface(cpt1)
                            swent.Select4(True, swSelData)
                        End If
                    Next cpt1
                    For cpt1 = 0 To UBound(TabEdge)
                        If TabEdgeDouble(0, cpt1) <> 1 Then
                            edgecount = edgecount + 1
                            swent = TabEdge(cpt1)
                            swent.Select4(True, swSelData)
                        End If
                    Next cpt1
                    For cpt1 = 0 To UBound(TabVertexDouble, 2)
                        If TabVertexDouble(0, cpt1) <> 1 Then
                            vertexcount = vertexcount + 1
                        End If
                    Next cpt1
                End If
            End If

            If b = True Then
                If cpt <> 0 Then
                    montrerpoints()
                End If
            End If

            If d = True Then
                If cpt <> 0 Then
                    For cpt1 = 0 To UBound(Tabface)
                        If TabFaceDouble(0, cpt1) <> 1 Then
                            facecount = facecount + 1
                        End If
                    Next cpt1
                    For cpt1 = 0 To UBound(TabEdge)
                        If TabEdgeDouble(0, cpt1) <> 1 Then
                            edgecount = edgecount + 1
                        End If
                    Next cpt1
                    For cpt1 = 0 To UBound(TabVertexDouble, 2)
                        If TabVertexDouble(0, cpt1) <> 1 Then
                            vertexcount = vertexcount + 1
                        End If
                    Next cpt1
                    Dim cptpointssommet As Long
                    Dim cptpointsarete As Long = 0
                    Dim cptpointsface As Long = 0
                    Dim cptpointsvolume As Long = 0
                    For Cpt2 = 1 To cpt
                        If TabPoints(4, Cpt2) = 0 Then cptpointssommet = cptpointssommet + 1
                        If TabPoints(4, Cpt2) = 1 Then cptpointsarete = cptpointsarete + 1
                        If TabPoints(4, Cpt2) = 2 Then cptpointsface = cptpointsface + 1
                        If TabPoints(4, Cpt2) = 3 Then cptpointsvolume = cptpointsvolume + 1
                    Next
                    'MsgBox(cpt & " Points créés sur : " & Chr(10) & facecount & " faces" & " -> " & cptpointsface & " points" & Chr(10) & edgecount & " aretes" & " -> " & cptpointsarete & " points" & Chr(10) & vertexcount & " sommets" & " -> " & cptpointssommet & " points" & Chr(10) & cptpointsvolume & " points dans le volume")
                End If
            End If

            If c = True Then
                vBoundingBox = swbody.GetBodyBox
                xmin = vBoundingBox(0)
                XMax = vBoundingBox(3)
                ymin = vBoundingBox(1)
                YMax = vBoundingBox(4)
                zmin = vBoundingBox(2)
                ZMax = vBoundingBox(5)
                'MsgBox("Xmin : " & Format(xmin, "0.0000") & Chr(9) & "Xmax : " & Format(XMax, "0.0000") & Chr(9) & "deltaX : " & Format((XMax - xmin), "0.0000") & Chr(10) & "Ymin : " & Format(ymin, "0.0000") & Chr(9) & "Ymax : " & Format(YMax, "0.0000") & Chr(9) & "deltaY : " & Format((YMax - ymin), "0.0000") & Chr(10) & "Zmin : " & Format(zmin, "0.0000") & Chr(9) & "Zmax : " & Format(ZMax, "0.0000") & Chr(9) & "deltaZ : " & Format((ZMax - zmin), "0.0000"))
            End If
            'Format(TabPoints(0, cpt1), "0.0000000e+00")
        Next vbody

        If e = True Then
            Dim path As String
            Dim CMDialogl As New Windows.Forms.OpenFileDialog
            CMDialogl.ShowDialog()
            path = CMDialogl.FileName
            'MsgBox("Ne fonctionne pas encore")
            If File.Exists(path) Then
                lire_fichier_ech(path)
            Else
                MsgBox("fichier inexistant")
            End If
        End If

    End Sub
    Sub testArrondis(ByRef coeff As Double)

        Dim swface As SldWorks.Face2
        Dim swfeat As SldWorks.Feature
        Dim FeatType As String
        Dim cpt1 As Integer
        Dim lmbd_arr As Integer
        Dim courb_arr As Double
        lmbd_arr = 5
        courb_arr = 1

        swface = swbody.GetFirstFace
        ' on parcours les faces si la feature est un congé on execute la sous routine arrondi
        For cpt1 = 0 To swbody.GetFaceCount - 1
            swfeat = swface.GetFeature
            FeatType = swfeat.GetTypeName
            If FeatType = "Fillet" Or FeatType = "VarFillet" Then
                Select Case Arrondi(swface)
                    Case 1
                        ' on creer les points sur la face si c est un arrondi
                        ChangeTabFace(swface, coeff, lmbd_arr, courb_arr)
                        ' si les congé ne sont pas des arrondis on verifie qu'il ne soit pas leur prolongement avec arrondi voisin
                    Case 2
                        If arrondivoisin(swface) = True Then
                            ChangeTabFace(swface, coeff, lmbd_arr, courb_arr)
                        End If
                    Case Else
                End Select
            End If
            swface = swface.GetNextFace
        Next cpt1

    End Sub
    Sub testretraitMatiere(ByRef Eng As Double, ByRef erx As Double)

        Dim swface As SldWorks.Face2
        Dim swsurface As SldWorks.Surface
        Dim swfaceref As SldWorks.Face2
        Dim swfeat As SldWorks.Feature
        Dim swloop As SldWorks.Loop2
        Dim cpt1 As Integer
        Dim cpt2 As Integer
        Dim swedge As SldWorks.Edge
        Dim swedgetmp As SldWorks.Edge
        Dim vedge As Object
        Dim vface As Object
        Dim cpt3 As Integer
        Dim cpt4 As Integer
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm As Integer
        Dim courb_rm As Double
        Dim coeff As Double
        Dim lg As Double
        Dim lgi As Double
        Dim angle As Double
        Dim n(2) As Double
        Dim area As Double
        Dim select_loop As Integer
        Dim t As Double
        Dim diametre As Double = 0
        Dim tmp() As Double


        lmbd_rm = 0
        courb_rm = 0

        swfaceref = swbody.GetFirstFace
        For cpt1 = 0 To swbody.GetFaceCount - 1
            diametre = 0
            swfeat = swfaceref.GetFeature
            swsurface = swfaceref.GetSurface
            swloop = swfaceref.GetFirstLoop
            For cpt2 = 0 To swfaceref.GetLoopCount - 1
                select_loop = 0
                If swloop.IsOuter = False Then
                    vedge = swloop.GetEdges
                    For cpt3 = 0 To swloop.GetEdgeCount - 1
                        swedge = vedge(cpt3)
                        vface = swedge.GetTwoAdjacentFaces
                        swface = vface(0)
                        If swface.IsSame(swfaceref) = True Then swface = vface(1)
                        angle = GetAngle(swedge, swfaceref, swface)
                        If angle < 179 Then
                            If (select_loop = 0) Then

                                n = direction_retrait_matiere(swloop, swfaceref)
                                lg = 0
                                For cpt4 = 0 To swloop.GetEdgeCount - 1
                                    swedgetmp = vedge(cpt4)
                                    lgi = get_edge_plane_lenght(swedgetmp, n)
                                    lg = lg + lgi
                                Next cpt4
                                area = get_loop_plane_area(swloop, n)

                                diametre = 4 * area / lg

                                select_loop = 1
                            End If
                            If diametre > 0.000001 Then
                                If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swface, coeff, lmbd_rm, courb_rm)
                            End If
                        End If
                    Next cpt3
                Else
                    If swfeat.GetTypeName = "HoleWzd" Then
                        diametre = 0
                        Dim hole As SldWorks.WizardHoleFeatureData2
                        hole = swfeat.GetDefinition
                        Select Case hole.Type
                            Case 0, 2 To 5, 7 To 9
                                diametre = hole.Diameter
                            Case 1, 6
                                diametre = (hole.MajorDiameter - hole.MinorDiameter) / 2
                            Case 10 To 13, 22 To 24, 43
                                diametre = hole.HoleDiameter
                            Case 14 To 21, 25 To 30, 44, 45
                                diametre = hole.ThruHoleDiameter
                            Case 31, 32, 37, 38, 46, 47
                                diametre = hole.TapDrillDiameter
                            Case 33 To 36, 39 To 42, 48 To 55
                                diametre = hole.ThruTapDrillDiameter
                            Case Else
                                MsgBox("Type de trou non reconnu")
                        End Select
                        If diametre > 0.000001 Then
                            If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swfaceref, coeff, lmbd_rm, courb_rm)
                        End If
                    Else
                        If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
                            diametre = 0
                            Dim params() As Double
                            If swsurface.Identity = 4002 Then
                                params = swsurface.CylinderParams
                                diametre = params(6) * 2
                            End If
                            If swsurface.Identity = 4003 Then
                                params = swsurface.ConeParams
                                diametre = params(6) * 2
                            End If
                            If swsurface.Identity = 4005 Then
                                params = swsurface.TorusParams
                                diametre = params(7) * 2
                            End If
                            If diametre > 0.000001 Then
                                If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swfaceref, coeff, lmbd_rm, courb_rm)
                            End If
                        End If
                    End If
                End If
                swloop = swloop.GetNext
            Next cpt2
            swfaceref = swfaceref.GetNextFace
        Next cpt1
    End Sub
    Sub testAngleMatiere(ByRef coeff As Double)

        Dim vface As Object
        Dim vedge As Object
        Dim swedge As SldWorks.Edge
        Dim swface As SldWorks.Face2
        Dim swface1 As SldWorks.Face2
        Dim swface2 As SldWorks.Face2
        Dim cpt1 As Integer
        Dim Phi As Double
        Dim swcurve As SldWorks.Curve
        Dim lmbd_am As Integer
        Dim courb_am As Double
        lmbd_am = 6
        courb_am = 2

        vedge = swbody.GetEdges
        ' on test les arete et on prend celles qui sont des lignes
        For cpt1 = 0 To swbody.GetEdgeCount - 1
            swedge = vedge(cpt1)
            swcurve = swedge.GetCurve
            'If swcurve.IsLine Then
            vface = swedge.GetTwoAdjacentFaces2
            If Not vface(1) Is Nothing Then
                swface1 = vface(0)
                swface2 = vface(1)
                'on test l'angle entre les deux face
                Phi = GetAngle(swedge, swface1, swface2)
                If Phi > 181 Then
                    ChangeTabEdge(swedge, coeff, lmbd_am, courb_am)
                End If
            End If
        Next cpt1

    End Sub
    Function GetAngle(ByRef swedge As SldWorks.Edge, ByRef swface1 As SldWorks.Face2, ByRef swface2 As SldWorks.Face2) As Double
        'cette fonction donne l'angle matière au centre de l'arête commune à deux faces
        Dim N1() As Double
        Dim N2() As Double
        Dim T1() As Double
        Dim T2() As Double
        Dim V1() As Double
        Dim V2() As Double
        Dim V1scalV2 As Double
        Dim N1scalV2 As Double
        Dim Phi As Double
        Dim a As Double
        Dim vEdgeparam As Object
        Dim swcurve As SldWorks.Curve
        Dim xyz As Object

        vEdgeparam = swedge.GetCurveParams2
        swcurve = swedge.GetCurve

        xyz = swcurve.Evaluate((vEdgeparam(7) - vEdgeparam(6)) / 2)

        N1 = getNormatAtPoint(xyz, swface1)
        N2 = getNormatAtPoint(xyz, swface2)

        T1 = GetTangent(swedge, swface1)
        T2 = GetTangent(swedge, swface2)

        T1 = Vecteur_Unitaire(T1)
        T2 = Vecteur_Unitaire(T2)

        V1 = Produitvectoriel(N1, T1)
        V2 = Produitvectoriel(N2, T2)

        V1scalV2 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
        N1scalV2 = N1(0) * V2(0) + N1(1) * V2(1) + N1(2) * V2(2)

        a = 0.0000001
        If N1scalV2 < 0 + a Then
            Phi = Math.Acos(V1scalV2) 'convexe
        Else
            Phi = 2 * 3.14159265 - Math.Acos(V1scalV2) 'concave
        End If

        GetAngle = Math.Abs(Phi * 360 / (2 * 3.14159265))

    End Function
    Function GetAngle(ByRef swedge As SldWorks.Edge, ByRef swface1 As SldWorks.Face2, ByRef swface2 As SldWorks.Face2, ByVal tc As Double) As Double
        'cette fonction donne l'angle matière au centre de l'arête commune à deux faces
        Dim N1() As Double
        Dim N2() As Double
        Dim T1() As Double
        Dim T2() As Double
        Dim V1() As Double
        Dim V2() As Double
        Dim V1scalV2 As Double
        Dim N1scalV2 As Double
        Dim Phi As Double
        Dim a As Double
        Dim vEdgeparam As Object
        Dim swcurve As SldWorks.Curve
        Dim xyz As Object

        vEdgeparam = swedge.GetCurveParams2
        swcurve = swedge.GetCurve
        tc = Math.Min(Math.Max(tc, vEdgeparam(6)), vEdgeparam(7))

        xyz = swcurve.Evaluate(tc)

        N1 = getNormatAtPoint(xyz, swface1)
        N2 = getNormatAtPoint(xyz, swface2)

        T1 = GetTangent(swedge, swface1, tc)
        T2 = GetTangent(swedge, swface2, tc)

        T1 = Vecteur_Unitaire(T1)
        T2 = Vecteur_Unitaire(T2)

        V1 = Produitvectoriel(N1, T1)
        V2 = Produitvectoriel(N2, T2)

        V1scalV2 = V1(0) * V2(0) + V1(1) * V2(1) + V1(2) * V2(2)
        N1scalV2 = N1(0) * V2(0) + N1(1) * V2(1) + N1(2) * V2(2)

        a = 0.0000001
        If N1scalV2 < 0 + a Then
            Phi = Math.Acos(V1scalV2) 'convexe
        Else
            Phi = 2 * 3.14159265 - Math.Acos(V1scalV2) 'concave
        End If

        GetAngle = Math.Abs(Phi * 360 / (2 * 3.14159265))
    End Function
    Function Get_vect_into_mat(ByRef swedge As SldWorks.Edge, ByRef swface1 As SldWorks.Face2, ByVal tc As Double) As Double()

        Dim N1() As Double
        Dim T1() As Double
        Dim V1() As Double
        Dim vEdgeparam As Object
        Dim swcurve As SldWorks.Curve
        Dim xyz As Object

        vEdgeparam = swedge.GetCurveParams2
        swcurve = swedge.GetCurve
        tc = Math.Min(Math.Max(tc, vEdgeparam(6)), vEdgeparam(7))

        xyz = swcurve.Evaluate(tc)

        N1 = getNormatAtPoint(xyz, swface1)
        T1 = GetTangent(swedge, swface1, tc)
        V1 = Produitvectoriel(N1, T1)
        V1 = Vecteur_Unitaire(V1)

        Get_vect_into_mat = V1

    End Function
    Function GetTangent(ByRef swedge As SldWorks.Edge, ByRef swface As SldWorks.Face2) As Double()
        'cette fonction donne la direction de la tangente au centre de l'arete spécifiée
        'La face donne la direction de la tangente 
        Dim swcurve As SldWorks.Curve
        Dim vMParam() As Double
        Dim vCurveParam() As Double
        Dim Edgesens As Boolean
        Dim Tangente(2) As Double
        Dim t1 As Double
        Dim t2 As Double

        swcurve = swedge.GetCurve
        vCurveParam = swedge.GetCurveParams2
        vMParam = swcurve.Evaluate((vCurveParam(7) - vCurveParam(6)) / 2)

        Edgesens = swedge.EdgeInFaceSense(swface)

        If Edgesens Then
            Tangente(0) = vMParam(3)
            Tangente(1) = vMParam(4)
            Tangente(2) = vMParam(5)
        Else
            Tangente(0) = -vMParam(3)
            Tangente(1) = -vMParam(4)
            Tangente(2) = -vMParam(5)
        End If

        GetTangent = Tangente

    End Function
    Function GetTangent(ByRef swedge As SldWorks.Edge, ByRef swface As SldWorks.Face2, ByVal tc As Double) As Double()
        'cette fonction donne la direction de la tangente en un point de l'arête de l'arete spécifiée 
        'La face donne la direction de la tangente 
        Dim swcurve As SldWorks.Curve
        Dim vMParam() As Double
        Dim vCurveParam() As Double
        Dim Edgesens As Boolean
        Dim Tangente(2) As Double
        Dim t1 As Double
        Dim t2 As Double

        swcurve = swedge.GetCurve
        vCurveParam = swedge.GetCurveParams2

        tc = Math.Min(Math.Max(tc, vCurveParam(6)), vCurveParam(7))
        vMParam = swcurve.Evaluate(tc)

        Edgesens = swedge.EdgeInFaceSense(swface)

        If Edgesens Then
            Tangente(0) = vMParam(3)
            Tangente(1) = vMParam(4)
            Tangente(2) = vMParam(5)
        Else
            Tangente(0) = -vMParam(3)
            Tangente(1) = -vMParam(4)
            Tangente(2) = -vMParam(5)
        End If

        GetTangent = Tangente

    End Function
    Function Arrondi(ByRef swface As SldWorks.Face2) As Integer
        Dim swsurface As SldWorks.Surface
        Dim vFaceUV() As Double
        Dim vParam() As Double
        Dim facesens As Boolean
        Dim dUU(2) As Double
        Dim dVV(2) As Double
        Dim Normal(2) As Double      'normale
        Dim NormU As Double
        Dim NormV As Double
        Dim xyz() As Double
        Dim vbbox() As Double

        vbbox = swface.GetBox
        swsurface = swface.GetSurface
        vFaceUV = swface.GetUVBounds
        vParam = swsurface.Evaluate((vFaceUV(1) - vFaceUV(0)) / 2, (vFaceUV(3) - vFaceUV(2)) / 2, 2, 2)
        If PointIsInFace(swface, vParam) = False Then
            xyz = swface.GetClosestPointOn(vParam(0), vParam(1), vParam(2))
            vFaceUV = swsurface.ReverseEvaluate(xyz(0), xyz(1), xyz(2))
            vParam = swsurface.Evaluate(vFaceUV(0), vFaceUV(1), 2, 2)
        End If

        facesens = swface.FaceInSurfaceSense

        If facesens Then
            Normal(0) = -vParam(27) : Normal(1) = -vParam(28) : Normal(2) = -vParam(29)
        Else
            Normal(0) = vParam(27) : Normal(1) = vParam(28) : Normal(2) = vParam(29)
        End If
        dUU(0) = vParam(6) : dUU(1) = vParam(7) : dUU(2) = vParam(8)
        dVV(0) = vParam(18) : dVV(1) = vParam(19) : dVV(2) = vParam(20)

        NormU = getNorme(dUU)
        NormV = getNorme(dVV)

        If NormU < 0.0000000000001 Then
            NormU = 0
        End If
        If NormV < 0.0000000000001 Then
            NormV = 0
        End If

        If NormU <> 0 And NormV <> 0 Then
            If NormU < NormV Then
                If Produit_scalaire(Normal, dUU) > 0 Then
                    Arrondi = 1
                Else
                    Arrondi = 2
                End If
            Else
                If Produit_scalaire(Normal, dVV) > 0 Then
                    Arrondi = 1
                Else
                    Arrondi = 2
                End If
            End If
        Else
            If NormU <> 0 Then
                If Produit_scalaire(Normal, dUU) > 0 Then
                    Arrondi = 1
                Else
                    Arrondi = 3
                End If
            Else
                If NormV <> 0 Then
                    If Produit_scalaire(Normal, dVV) > 0 Then
                        Arrondi = 1
                    Else
                        Arrondi = 3
                    End If
                End If
            End If
        End If
    End Function
    Function getNorme(ByRef u() As Double) As Double
        'cette fonction norme le vecteur u
        Dim norm As Double
        norm = (u(0) * u(0) + u(1) * u(1) + u(2) * u(2)) ^ 0.5
        Return norm
    End Function
    Function Produit_scalaire(ByRef u() As Double, ByRef v() As Double) As Double
        'Cette fonction donne le produit scalaire de deux vecteurs de dimension 3
        Produit_scalaire = u(0) * v(0) + u(1) * v(1) + u(2) * v(2)
    End Function
    Function arrondivoisin(ByRef swface As SldWorks.Face2) As Boolean
        ' cette fonction teste si la face donné a des faces "arrondis" comme voisines
        Dim vedge As Object
        Dim swEdge As SldWorks.Edge
        Dim vface As Object
        Dim swfaceadja As SldWorks.Face2
        Dim swfeat As SldWorks.Feature
        Dim FeatType As String
        Dim cpt1 As Integer
        Dim i As Integer
        Dim swEndVert As SldWorks.Vertex
        Dim swStartVert As SldWorks.Vertex

        vedge = swface.GetEdges
        For cpt1 = 0 To swface.GetEdgeCount - 1
            swEdge = vedge(cpt1)
            vface = swEdge.GetTwoAdjacentFaces
            For i = 0 To 1
                swfaceadja = vface(i)
                If swfaceadja.IsSame(swface) = False Then
                    swfeat = swfaceadja.GetFeature
                    FeatType = swfeat.GetTypeName
                    If FeatType = "Fillet" Or FeatType = "VarFillet" Then
                        If Arrondi(swfaceadja) = 1 Then
                            swEndVert = swEdge.GetStartVertex
                            swStartVert = swEdge.GetEndVertex
                            If testcontinuite(swEdge, swface, swfaceadja, swEndVert) = True Then
                                Return True 'arrondivoisin = True
                            Else
                                If testcontinuite(swEdge, swface, swfaceadja, swStartVert) = True Then
                                    Return True 'arrondivoisin = True
                                End If
                            End If
                        End If
                    End If
                End If
            Next i
        Next cpt1
    End Function
    Function testcontinuite(ByRef swedge As SldWorks.Edge, ByRef swface As SldWorks.Face2, ByRef swfaceAdj As SldWorks.Face2, ByRef swVert As SldWorks.Vertex) As Boolean
        'cette fonction test si l'arete appartenant à la face est continue avec une des aretes contenant le meme point de la face adjacente
        Dim vedge As Object
        Dim swEdgeAdj As SldWorks.Edge
        Dim vface As Object
        Dim swface1 As SldWorks.Face2
        Dim swface2 As SldWorks.Face2
        Dim i As Integer

        vedge = swVert.GetEdges
        For i = 0 To UBound(vedge)
            swEdgeAdj = vedge(i)
            vface = swEdgeAdj.GetTwoAdjacentFaces2
            swface1 = vface(0)
            swface2 = vface(1)
            If swface1.IsSame(swface) = False And swface2.IsSame(swface) = False Then
                If swface1.IsSame(swfaceAdj) = True Or swface2.IsSame(swfaceAdj) = True Then
                    If testedgeIsSame(swEdgeAdj, swface, swfaceAdj) = True Then
                        Return True 'testcontinuite = True
                    End If
                End If
            End If
        Next i
    End Function
    Function testedgeIsSame(ByRef swedge As SldWorks.Edge, ByRef swface As SldWorks.Face2, ByRef swfaceAdj As SldWorks.Face2) As Boolean

        Dim vedgetan As Object
        Dim swedgetan As SldWorks.Edge
        Dim vface As Object
        Dim swface1 As SldWorks.Face2
        Dim swface2 As SldWorks.Face2
        Dim i As Integer

        vedgetan = swedge.GetTangentEdges
        For i = 0 To swedge.GetTangentEdgesCount - 1
            swedgetan = vedgetan(i)
            vface = swedgetan.GetTwoAdjacentFaces2
            swface1 = vface(0)
            swface2 = vface(1)
            If swface1.IsSame(swface) = True Or swface2.IsSame(swface) = True Then
                Return True
            End If
        Next i

    End Function
    Function Vecteur_Unitaire(ByRef varVec1() As Double) As Double()
        ' cette fonction donne le vecteur unitaire du vecteur
        Dim dblMag As Double
        Dim dblUnit1(2) As Double

        dblMag = (varVec1(0) * varVec1(0) + varVec1(1) * varVec1(1) + varVec1(2) * varVec1(2)) ^ 0.5
        dblUnit1(0) = varVec1(0) / dblMag : dblUnit1(1) = varVec1(1) / dblMag : dblUnit1(2) = varVec1(2) / dblMag

        Vecteur_Unitaire = dblUnit1

    End Function
    Function Produitvectoriel(ByRef varVec1() As Double, ByRef varVec2() As Double) As Double()
        'Cette fonction donne le produit vectoriel de deux vecteurs de dimension 3
        Dim dblCross(2) As Double

        dblCross(0) = varVec1(1) * varVec2(2) - varVec1(2) * varVec2(1)
        dblCross(1) = varVec1(2) * varVec2(0) - varVec1(0) * varVec2(2)
        dblCross(2) = varVec1(0) * varVec2(1) - varVec1(1) * varVec2(0)
        Produitvectoriel = dblCross
    End Function
    Function PointIsInFace(ByRef swface As SldWorks.Face2, ByRef xyz() As Double) As Boolean
        ' cette fonction test si le point appartient à la face
        Dim x1y1z1() As Double
        Dim a As Double = 0.000000001
        Dim vedge As Object
        Dim swedge As SldWorks.Edge
        Dim cpt1 As Integer

        vedge = swface.GetEdges
        x1y1z1 = swface.GetClosestPointOn(xyz(0), xyz(1), xyz(2))

        If x1y1z1(0) < xyz(0) + a And x1y1z1(0) > xyz(0) - a And _
        x1y1z1(1) < xyz(1) + a And x1y1z1(1) > xyz(1) - a And _
        x1y1z1(2) < xyz(2) + a And x1y1z1(2) > xyz(2) - a Then
            For cpt1 = 0 To swface.GetEdgeCount - 1
                swedge = vedge(cpt1)
                x1y1z1 = swedge.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
                If x1y1z1(0) < xyz(0) + a And x1y1z1(0) > xyz(0) - a And _
                    x1y1z1(1) < xyz(1) + a And x1y1z1(1) > xyz(1) - a And _
                    x1y1z1(2) < xyz(2) + a And x1y1z1(2) > xyz(2) - a Then
                Else
                    Return True
                    cpt1 = swface.GetEdgeCount - 1
                End If
            Next cpt1
        Else
            Return False
        End If
    End Function
    Function VertexExist(ByRef xyz() As Double) As Boolean
        'cette fonction test si le sommet existe dans le tableau des sommets
        Dim i As Integer
        Dim a As Double

        a = 0.0000000000001
        If cptVertex <> 0 Then
            For i = 0 To cptVertex - 1
                If xyz(0) < TabVertex(0, i) + a And xyz(0) > TabVertex(0, i) - a And _
                    xyz(1) < TabVertex(1, i) + a And xyz(1) > TabVertex(1, i) - a And _
                    xyz(2) < TabVertex(2, i) + a And xyz(2) > TabVertex(2, i) - a Then
                    Return False
                Else
                    VertexExist = True
                End If
            Next i
        Else
            VertexExist = True
        End If

    End Function
    Function Facecirculaire(ByRef swface As SldWorks.Face2) As Integer
        'cette fonction teste si la face est cylindrique spherique ou autre
        Dim swsurface As SldWorks.Surface
        Dim vUVbound() As Double
        Dim vUVXYZdebut() As Double
        Dim UVXYZdebut(2) As Double
        Dim vUXYZfin() As Double
        Dim UXYZfin(2) As Double
        Dim vVXYZfin() As Double
        Dim VXYZfin(2) As Double

        swsurface = swface.GetSurface
        vUVbound = swface.GetUVBounds
        vUVXYZdebut = swsurface.Evaluate(vUVbound(0), vUVbound(2), 0, 0)
        vUXYZfin = swsurface.Evaluate(vUVbound(1), vUVbound(2), 0, 0)
        vVXYZfin = swsurface.Evaluate(vUVbound(0), vUVbound(3), 0, 0)
        UVXYZdebut(0) = vUVXYZdebut(0) : UVXYZdebut(1) = vUVXYZdebut(1) : UVXYZdebut(2) = vUVXYZdebut(2)
        UXYZfin(0) = vUXYZfin(0) : UXYZfin(1) = vUXYZfin(1) : UXYZfin(2) = vUXYZfin(2)
        VXYZfin(0) = vVXYZfin(0) : VXYZfin(1) = vVXYZfin(1) : VXYZfin(2) = vVXYZfin(2)

        If PointIsInFace(swface, UVXYZdebut) = False Then
            Facecirculaire = 4
        Else
            If PointEgale(UVXYZdebut, UXYZfin) Then
                If PointEgale(UVXYZdebut, VXYZfin) Then
                    Facecirculaire = 1
                Else
                    Facecirculaire = 2
                End If
            Else
                If PointEgale(UVXYZdebut, VXYZfin) Then
                    Facecirculaire = 3
                Else
                    Facecirculaire = 4
                End If
            End If
        End If
    End Function
    Function Edgecirculaire(ByRef swedge As SldWorks.Edge) As Integer
        'cette fonction test si l'arete est cylindrique ou autre
        Dim edgeparam() As Double
        Dim pointdebut(2) As Double
        Dim pointfin(2) As Double

        edgeparam = swedge.GetCurveParams2
        pointdebut(0) = edgeparam(0) : pointdebut(1) = edgeparam(1) : pointdebut(2) = edgeparam(2)
        pointfin(0) = edgeparam(3) : pointfin(1) = edgeparam(4) : pointfin(2) = edgeparam(5)
        If PointEgale(pointdebut, pointfin) = True Then
            Edgecirculaire = 2
        Else
            Edgecirculaire = 1
        End If

    End Function
    Function PointEgale(ByRef xyz1() As Double, ByRef xyz2() As Double) As Boolean
        'cette fonction test si les deux points sont égaux
        Dim a As Double
        a = 0.0000000000001
        If xyz1(0) < xyz2(0) + a And xyz1(0) > xyz2(0) - a And _
        xyz1(1) < xyz2(1) + a And xyz1(1) > xyz2(1) - a And _
        xyz1(2) < xyz2(2) + a And xyz1(2) > xyz2(2) - a Then
            PointEgale = True
        Else
            PointEgale = False
        End If
    End Function
    Function getNormatAtPoint(ByRef P() As Double, ByRef swface As SldWorks.Face2) As Double()
        'cette fonction donne la normale à la face au point P
        Dim swsurface As SldWorks.Surface
        Dim xyzP(2) As Double
        Dim UVP() As Double
        Dim vSurfparam() As Double
        Dim facesens As Boolean
        Dim Nxyz(2) As Double

        swsurface = swface.GetSurface
        UVP = swsurface.ReverseEvaluate(P(0), P(1), P(2))
        If UVP Is Nothing Then
            xyzP = swsurface.GetClosestPointOn(P(0), P(1), P(2))
            UVP = swsurface.ReverseEvaluate(xyzP(0), xyzP(1), xyzP(2))
        End If

        vSurfparam = swsurface.Evaluate(UVP(0), UVP(1), 0, 0)

        facesens = swface.FaceInSurfaceSense
        If facesens Then
            Nxyz(0) = -vSurfparam(3) : Nxyz(1) = -vSurfparam(4) : Nxyz(2) = -vSurfparam(5)
        Else
            Nxyz(0) = vSurfparam(3) : Nxyz(1) = vSurfparam(4) : Nxyz(2) = vSurfparam(5)
        End If

        getNormatAtPoint = Nxyz

    End Function
    Function faceIsAlreadyRepear(ByRef swface As SldWorks.Face2) As Boolean
        'Cette fonction test si la face a déja été repérée dans le tableau de face
        Dim cpt1 As Integer
        Dim swfacetab As SldWorks.Face2

        For cpt1 = 0 To UBound(Tabface)
            swfacetab = Tabface(cpt1)
            If swface.IsSame(swfacetab) Then
                If TabFaceDouble(0, cpt1) <> 1 Then
                    Return True
                Else
                    Return False
                End If
            End If
        Next cpt1


    End Function
    Function IsInBodyBox(ByRef P() As Double) As Boolean
        'cette fonction test si le point P est dans la boite englobante
        Dim BodyBox() As Double
        BodyBox = swbody.GetBodyBox
        If P(0) < BodyBox(0) Or P(1) < BodyBox(1) Or P(2) < BodyBox(2) _
        Or P(0) > BodyBox(3) Or P(1) > BodyBox(4) Or P(2) > BodyBox(5) Then
            IsInBodyBox = False
        Else
            IsInBodyBox = True
        End If
    End Function
    Function GetUVLong(ByRef swFace As SldWorks.Face2) As Object
        'Cette fonction donne la plus grande isoparametrique des 2 direction u et v avec u = umin ou umax ou v = vmin ou vmax
        Dim LUvmin As Double = 0
        Dim LVumin As Double = 0
        Dim LUvmax As Double = 0
        Dim LVumax As Double = 0
        Dim UVL(1) As Double
        Dim vUV() As Double
        Dim IncrU As Double
        Dim IncrV As Double
        Dim Pincr() As Double
        Dim nbIncr As Integer = 25
        Dim PP(2, 99) As Double
        Dim swsurface As SldWorks.Surface
        Dim i As Integer
        Dim u As Integer

        swsurface = swFace.GetSurface
        vUV = swFace.GetUVBounds

        IncrU = (vUV(1) - vUV(0)) / nbIncr
        IncrV = (vUV(3) - vUV(2)) / nbIncr

        For i = 0 To nbIncr
            Pincr = swsurface.Evaluate(vUV(0) + i * IncrU, vUV(2), 0, 0)
            PP(0, i) = Pincr(0) : PP(1, i) = Pincr(1) : PP(2, i) = Pincr(2)
        Next i
        For u = 0 To nbIncr - 1
            LUvmin = LUvmin + Dist(PP(0, u), PP(1, u), PP(2, u), PP(0, u + 1), PP(1, u + 1), PP(2, u + 1))
        Next u

        For i = 0 To nbIncr
            Pincr = swsurface.Evaluate(vUV(0) + i * IncrU, vUV(3), 0, 0)
            PP(0, i) = Pincr(0) : PP(1, i) = Pincr(1) : PP(2, i) = Pincr(2)
        Next i
        For u = 0 To nbIncr - 1
            LUvmax = LUvmax + Dist(PP(0, u), PP(1, u), PP(2, u), PP(0, u + 1), PP(1, u + 1), PP(2, u + 1))
        Next u

        For i = 0 To nbIncr
            Pincr = swsurface.Evaluate(vUV(0), vUV(2) + i * IncrV, 0, 0)
            PP(0, i) = Pincr(0) : PP(1, i) = Pincr(1) : PP(2, i) = Pincr(2)
        Next i
        For u = 0 To nbIncr - 1
            LVumin = LVumin + Dist(PP(0, u), PP(1, u), PP(2, u), PP(0, u + 1), PP(1, u + 1), PP(2, u + 1))
        Next u

        For i = 0 To nbIncr
            Pincr = swsurface.Evaluate(vUV(1), vUV(2) + i * IncrV, 0, 0)
            PP(0, i) = Pincr(0) : PP(1, i) = Pincr(1) : PP(2, i) = Pincr(2)
        Next i
        For u = 0 To nbIncr - 1
            LVumax = LVumax + Dist(PP(0, u), PP(1, u), PP(2, u), PP(0, u + 1), PP(1, u + 1), PP(2, u + 1))
        Next u

        UVL(0) = Math.Max(LUvmin, LUvmax) : UVL(1) = Math.Max(LVumin, LVumax)

        GetUVLong = UVL
    End Function
    Function GetEdgeLenght(ByRef swedge As SldWorks.Edge) As Double
        'cette fonction donne la longueur de l'arete
        Dim swcurve As SldWorks.Curve
        Dim lenght As Double
        Dim vParam() As Double
        vParam = swedge.GetCurveParams2
        swcurve = swedge.GetCurve
        lenght = swcurve.GetLength2(vParam(6), vParam(7))
        'lenght = get_edge_lenght(swedge, vParam(6), vParam(7))
        GetEdgeLenght = lenght
    End Function
    Function Dist(ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As Double
        'cette fonction donne la distance entre les deux points
        Dist = ((x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^ 2) ^ (1 / 2)
    End Function
    Function FonctionVolume(ByRef x As Double, ByRef a As Double, ByVal F As Integer) As Double()
        ' cette fonction définit la fonction de variation de l'écart nodal dans le volume
        Dim u As Double
        Dim fx As Double
        Dim fprim As Double
        Dim intvl As Double
        Dim Pasest As Double
        Dim Funct(2) As Double
        Dim Param As Double
        Select Case F

            Case 1
                intvl = 10
                u = intvl * x
                fx = (u + a) / (u + 1)
                fprim = intvl * (1 - a) / ((u + 1) * (u + 1))

            Case 2
                fx = (x ^ 5 + a) / (x + 1)
                fprim = (4 * x ^ 5 + 5 * x ^ 4 - a) / ((x + 1) * (x + 1))
                intvl = 1
                Pasest = intvl / 10

            Case 3
                fx = 0.3 * x
                fprim = 0.3

            Case 4
                fx = (x ^ 3 + a) / (x + 1)
                fprim = (2 * x ^ 3 + 3 * x ^ 2 - a) / ((x + 1) * (x + 1))

            Case 5
                fx = a + (1 - 2 * a) * Math.Sin(3.14 * x)
                fprim = (1 - 2 * a) * Math.Cos(3.14 * x) * 3.14

        End Select

        Funct(0) = fx
        Funct(1) = fprim
        Funct(2) = Math.Abs(fprim - 1 + a)

        FonctionVolume = Funct
    End Function
    Function FonctionVolume2(ByRef x As Double, ByRef eng As Double, ByRef eni As Double, ByRef delta As Double, ByRef F As Integer) As Double

        Dim fx As Double
        Dim b As Double = 0.1

        Select Case F

            Case 1
                fx = eni + (eng - eni) * (x / delta)
            Case 2
                fx = -(b * eni * (x - delta) - (b + 1) * x * eng) / (x + b * delta)
            Case 3
                fx = ((b + 1) * eni * (x - delta) - b * x * eng) / (x - (b + 1) * delta)
        End Select


        FonctionVolume2 = fx

    End Function
    Function GetFirstIntersectFace(ByRef Dir() As Double, ByRef Pt() As Double) As SldWorks.Face2
        'Donne la premiere face intersecté dans une direction à partir d'1 point
        'rayintersection fonctionne pas avec vb.net : a voir avec la version SW 2006
        Dim swface As SldWorks.Face2
        Dim VInterParam(6) As Double
        Dim status As Boolean

        VInterParam(0) = Pt(0) + 0.00001 * Dir(0) : VInterParam(1) = Pt(1) + 0.00001 * Dir(1) : VInterParam(2) = Pt(2) + 0.00001 * Dir(2)
        VInterParam(3) = Dir(0) : VInterParam(4) = Dir(1) : VInterParam(5) = Dir(2)
        VInterParam(6) = 0
        swModel.ClearSelection2(True)
        status = swModel.SelectByRay(VInterParam, 2)
        If status = True Then
            Dim swSelMgr As SldWorks.SelectionMgr = swModel.SelectionManager
            swface = swSelMgr.GetSelectedObject5(1)
            Return swface
        Else
            Return Nothing
        End If

    End Function
    Function GetPointFirstIntersectFace(ByRef Dir() As Double, ByRef Pt() As Double, ByRef Swface As SldWorks.Face2) As Double()
        ' Donne le point appartenant a la premiere face intersecté dans une direction à partir d'un point
        Dim modeler As SldWorks.Modeler
        Dim swcurve As SldWorks.Curve
        Dim retval As Object
        Dim vCurveParam As Object
        Dim startp(2) As Double
        Dim endp(2) As Double
        Dim vStart As Object
        Dim vEnd As Object
        Dim swsurf As SldWorks.Surface
        Dim vCurvebounds(5) As Double
        Dim i As Integer
        Dim knots(3) As Double
        Dim ctrlPoints(5) As Double
        Dim props As Object
        Dim dProps(1) As Double
        Dim vKnots As Object, vCtrlPoints As Object
        Dim bRet As Boolean
        Dim vPointArray As Object, vTArray As Object, vUVArray As Object

        If Not Swface Is Nothing Then
            swsurf = Swface.GetSurface
            modeler = swApp.GetModeler
            swcurve = modeler.CreateLine(Pt, Dir)

            'Dim closestpoint() As Double
            'closestpoint = Swface.GetClosestPointOn(Pt(0), Pt(1), Pt(2))

            startp(0) = Pt(0) : startp(1) = Pt(1) : startp(2) = Pt(2)
            'startp(0) = closestpoint(0) : startp(1) = closestpoint(1) : startp(2) = closestpoint(2)
            vStart = startp

            endp(0) = Pt(0) + 0.01 * Dir(0) : endp(1) = Pt(1) + 0.01 * Dir(1) : endp(2) = Pt(2) + 0.01 * Dir(2)
            While IsInBodyBox(endp) = True
                endp(0) = endp(0) + 0.01 * Dir(0)
                endp(1) = endp(1) + 0.01 * Dir(1)
                endp(2) = endp(2) + 0.01 * Dir(2)
            End While
            vEnd = endp

            For i = 0 To 2
                vCurvebounds(i) = startp(i)
                vCurvebounds(3 + i) = endp(i)
            Next

            retval = swcurve.ConvertLineToBcurve(vStart, vEnd)
            ' on suppose que la droite est toujours transformée en spline non-rationelle de dimension 3 et d'ordre 2

            knots(0) = retval(2) : knots(1) = retval(3) : knots(2) = retval(4) : knots(3) = retval(5)
            ctrlPoints(0) = retval(6) : ctrlPoints(1) = retval(7) : ctrlPoints(2) = retval(8) : ctrlPoints(3) = retval(9) : ctrlPoints(4) = retval(10) : ctrlPoints(5) = retval(11)

            dProps(0) = retval(0)
            dProps(1) = retval(1)
            props = dProps
            vKnots = knots
            vCtrlPoints = ctrlPoints

            swcurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)

            bRet = swsurf.IntersectCurve(swcurve, vCurvebounds, vPointArray, vTArray, vUVArray)
            Return vPointArray
        Else
            Return Nothing
        End If
    End Function
    Function DistPointFace(ByRef Pt() As Double, ByRef Dir() As Double, ByRef Swface As SldWorks.Face2) As Double
        'donne la distance entre un point et la face
        'A cause que rAYintersection marche pas avec Vbnet
        Dim distance As Double
        Dim vPointArray() As Double

        vPointArray = GetPointFirstIntersectFace(Dir, Pt, Swface)
        If vPointArray.Length > 1 Then
            If IsInSurfSens(Pt, vPointArray, Swface) = True Then
                If PointIsInFace(Swface, vPointArray) Then
                    distance = Dist(Pt(0), Pt(1), Pt(2), vPointArray(0), vPointArray(1), vPointArray(2))
                End If
            End If

            If UBound(vPointArray) > 2 Then
                Dim i As Integer
                Dim di As Double
                Dim xyz(2) As Double
                For i = 3 To UBound(vPointArray) - 1 Step 3
                    xyz(0) = vPointArray(0 + i) : xyz(1) = vPointArray(1 + i) : xyz(2) = vPointArray(2 + i)
                    di = Dist(Pt(0), Pt(1), Pt(2), xyz(0), xyz(1), xyz(2))
                    If IsInSurfSens(Pt, xyz, Swface) = True Then
                        If PointIsInFace(Swface, xyz) Then
                            distance = Math.Min(di, distance)
                        End If
                    End If
                Next
            End If
            Return distance
        Else
            Return 0
        End If

    End Function
    Function IsInSurfSens(ByRef Porigin() As Double, ByRef Pface() As Double, ByRef swface As SldWorks.Face2) As Boolean
        'fonction spécifique 
        Dim Vect(2) As Double
        Dim Normale() As Double
        Dim VscalN As Double

        Vect(0) = Pface(0) - Porigin(0)
        Vect(1) = Pface(1) - Porigin(1)
        Vect(2) = Pface(2) - Porigin(2)
        Vect = Vecteur_Unitaire(Vect)
        Normale = getNormatAtPoint(Pface, swface)
        Normale = Vecteur_Unitaire(Normale)
        VscalN = Produit_scalaire(Vect, Normale)

        If VscalN > 0 Then Return True Else  : Return False

    End Function
    Function EdgeIsRepair(ByRef swedge As SldWorks.Edge) As Boolean
        ' cette fonction permet de tester si une arête à déja été repérée
        Dim Cprm1() As Double
        Dim Cprm2() As Double
        Dim Strpt1(2) As Double
        Dim Endpt1(2) As Double
        Dim Strpt2(2) As Double
        Dim Endpt2(2) As Double
        Dim swedge2 As SldWorks.Edge
        Dim i As Integer

        Cprm1 = swedge.GetCurveParams2
        Strpt1(0) = Cprm1(0) : Strpt1(1) = Cprm1(1) : Strpt1(2) = Cprm1(2)
        Endpt1(0) = Cprm1(3) : Endpt1(1) = Cprm1(4) : Endpt1(2) = Cprm1(5)

        For i = 0 To UBound(TabEdge)
            If TabEdgeDouble(0, i) <> 1 Then
                swedge2 = TabEdge(i)
                Cprm2 = swedge2.GetCurveParams2
                Strpt2(0) = Cprm2(0) : Strpt2(1) = Cprm2(1) : Strpt2(2) = Cprm2(2)
                If PointEgale(Strpt1, Strpt2) = True Or PointEgale(Endpt1, Strpt2) Then
                    Endpt2(0) = Cprm2(3) : Endpt2(1) = Cprm2(4) : Endpt2(2) = Cprm2(5)
                    If PointEgale(Endpt1, Endpt2) = True Or PointEgale(Strpt1, Endpt2) Then
                        Return True
                    End If
                End If
            End If
        Next
        Return False
    End Function
    Function Txtpath(ByVal path As String) As String
        Dim Carray() As String
        Carray = path.Split(".")
        If Not Carray(UBound(Carray)) = "txt" Then
            path = path & ".txt"
        End If
        Return path
    End Function
    Sub BoiteEnglobante()
        ' Ecrit la boite englobante dans le tableau de points
        Dim BodyBox() As Double
        Dim cpt1 As Integer

        BodyBox = swbody.GetBodyBox
        ReDim Preserve TabPoints(8, cpt)

        For cpt1 = 0 To 5
            TabPoints(cpt1, 0) = BodyBox(cpt1)
        Next cpt1

    End Sub
    Sub initialisation()
        'initialise les entité comme n'étant pas raffiné i.e. avec un coeff de raffinement de maillage = 1
        Dim swface As SldWorks.Face2
        Dim cptface As Integer
        Dim cptedge As Integer
        Dim vEdge As Object
        Dim swEdge As SldWorks.Edge
        Dim vEdgeParam() As Double
        Dim point(2) As Double
        Dim cpt1 As Integer

        swface = swbody.GetFirstFace

        ReDim Preserve Tabface(swbody.GetFaceCount - 1)
        ReDim Preserve TabFaceDouble(2, swbody.GetFaceCount - 1)
        ReDim Preserve TabEdge(swbody.GetEdgeCount - 1)
        ReDim Preserve TabEdgeDouble(2, swbody.GetEdgeCount - 1)

        For cptface = 0 To swbody.GetFaceCount - 1
            Tabface(cptface) = swface
            TabFaceDouble(0, cptface) = 1
            TabFaceDouble(1, cptface) = 4
            TabFaceDouble(2, cptface) = 0
            swface = swface.GetNextFace
        Next cptface
        vEdge = swbody.GetEdges
        For cptedge = 0 To swbody.GetEdgeCount - 1
            TabEdge(cptedge) = vEdge(cptedge)
            TabEdgeDouble(0, cptedge) = 1
            TabEdgeDouble(1, cptedge) = 4
            TabEdgeDouble(2, cptedge) = 0
        Next cptedge

        cptVertex = 0

        For cpt1 = 0 To swbody.GetEdgeCount - 1
            swEdge = vEdge(cpt1)
            vEdgeParam = swEdge.GetCurveParams2
            point(0) = vEdgeParam(0)
            point(1) = vEdgeParam(1)
            point(2) = vEdgeParam(2)
            If VertexExist(point) = True Then
                ReDim Preserve TabVertex(2, cptVertex)
                ReDim Preserve TabVertexDouble(2, cptVertex)
                TabVertex(0, cptVertex) = point(0)
                TabVertex(1, cptVertex) = point(1)
                TabVertex(2, cptVertex) = point(2)
                TabVertexDouble(0, cptVertex) = 1
                TabVertexDouble(1, cptVertex) = 4
                TabVertexDouble(2, cptVertex) = 0
                cptVertex = cptVertex + 1
            End If
            point(0) = vEdgeParam(3)
            point(1) = vEdgeParam(4)
            point(2) = vEdgeParam(5)
            If VertexExist(point) = True Then
                ReDim Preserve TabVertex(2, cptVertex)
                ReDim Preserve TabVertexDouble(2, cptVertex)
                TabVertex(0, cptVertex) = point(0)
                TabVertex(1, cptVertex) = point(1)
                TabVertex(2, cptVertex) = point(2)
                TabVertexDouble(0, cptVertex) = 1
                TabVertexDouble(1, cptVertex) = 4
                TabVertexDouble(2, cptVertex) = 0
                cptVertex = cptVertex + 1
            End If
        Next cpt1

    End Sub
    Sub ChangeTabFace(ByRef swface As SldWorks.Face2, ByRef coeff As Double, Optional ByRef lambda As Double = 4, Optional ByRef courbure As Double = 0)
        'Change la valeur du coeff de raff de maill et lambda et courbure  du tableau des faces du modele
        Dim swfacetab As SldWorks.Face2
        Dim cpt1 As Integer
        Dim vedge As Object
        Dim swedge As SldWorks.Edge
        Dim cpt2 As Integer

        For cpt1 = 0 To UBound(Tabface)
            swfacetab = Tabface(cpt1)
            If swface.IsSame(swfacetab) Then
                If TabFaceDouble(0, cpt1) > coeff Then
                    TabFaceDouble(0, cpt1) = coeff
                    TabFaceDouble(1, cpt1) = lambda
                    TabFaceDouble(2, cpt1) = courbure

                    vedge = swface.GetEdges
                    For cpt2 = 0 To swface.GetEdgeCount - 1
                        swedge = vedge(cpt2)
                        ChangeTabEdge(swedge, coeff, lambda, courbure)
                    Next cpt2
                End If
            End If
        Next cpt1
    End Sub
    Sub ChangeTabEdge(ByRef swedge As SldWorks.Edge, ByRef coeff As Double, Optional ByRef lambda As Double = 4, Optional ByRef courbure As Double = 0)
        ' comme changetabface mais pour les aretes
        Dim swedgetab As SldWorks.Edge
        Dim ParamEdgeTab() As Double
        Dim ParamEdge() As Double
        Dim cpt1 As Integer
        For cpt1 = 0 To UBound(TabEdge)
            swedgetab = TabEdge(cpt1)
            ParamEdgeTab = swedgetab.GetCurveParams2
            ParamEdge = swedge.GetCurveParams2
            If ParamEdgeTab(0) = ParamEdge(0) And _
            ParamEdgeTab(1) = ParamEdge(1) And _
            ParamEdgeTab(2) = ParamEdge(2) And _
            ParamEdgeTab(3) = ParamEdge(3) And _
            ParamEdgeTab(4) = ParamEdge(4) And _
            ParamEdgeTab(5) = ParamEdge(5) And _
            ParamEdgeTab(6) = ParamEdge(6) And _
            ParamEdgeTab(7) = ParamEdge(7) Then
                If TabEdgeDouble(0, cpt1) > coeff Then
                    TabEdgeDouble(0, cpt1) = coeff
                    TabEdgeDouble(1, cpt1) = lambda
                    TabEdgeDouble(2, cpt1) = courbure
                    Changetabvertex(swedge, coeff, lambda, courbure)
                End If
            End If
        Next cpt1
    End Sub
    Sub Changetabvertex(ByRef swedge As SldWorks.Edge, ByRef coeff As Double, Optional ByRef lambda As Double = 4, Optional ByRef courbure As Double = 0)
        'et pour les sommet
        Dim vParamEdge() As Double
        Dim i As Integer
        Dim a As Double
        Dim b As Integer

        vParamEdge = swedge.GetCurveParams2
        b = Edgecirculaire(swedge)
        If b = 1 Then
            a = 0.0000000000001
            For i = 0 To cptVertex - 1
                If vParamEdge(0) < TabVertex(0, i) + a And vParamEdge(0) > TabVertex(0, i) - a And _
                    vParamEdge(1) < TabVertex(1, i) + a And vParamEdge(1) > TabVertex(1, i) - a And _
                    vParamEdge(2) < TabVertex(2, i) + a And vParamEdge(2) > TabVertex(2, i) - a Then
                    If coeff < TabVertexDouble(0, i) Then
                        TabVertexDouble(0, i) = coeff
                        TabVertexDouble(1, i) = lambda
                        TabVertexDouble(2, i) = courbure
                    End If
                End If
            Next i
            For i = 0 To cptVertex - 1
                If vParamEdge(3) < TabVertex(0, i) + a And vParamEdge(3) > TabVertex(0, i) - a And _
                    vParamEdge(4) < TabVertex(1, i) + a And vParamEdge(4) > TabVertex(1, i) - a And _
                    vParamEdge(5) < TabVertex(2, i) + a And vParamEdge(5) > TabVertex(2, i) - a Then
                    If coeff < TabVertexDouble(0, i) Then
                        TabVertexDouble(0, i) = coeff
                        TabVertexDouble(1, i) = lambda
                        TabVertexDouble(2, i) = courbure
                    End If
                End If
            Next i
        End If
    End Sub
    Sub CreerPointsVertex(ByRef Eng As Double, ByRef grill As grille)
        'créee les points sur les sommets
        Dim i As Integer
        Dim swvertex As SldWorks.Vertex
        Dim pt1 As point_grille
        Dim inserer As Boolean

        For i = 0 To cptVertex - 1
            If TabVertexDouble(0, i) <> 1 Then
                Dim listpts As New Collection
                grill.rechercher(TabVertex(0, i), TabVertex(1, i), TabVertex(2, i), 0.5 * Eng * (1 - TabVertexDouble(0, i)), listpts)
                inserer = False
                If listpts.Count = 0 Then
                    inserer = True
                Else
                    Dim cmin As Double = 1
                    Dim c_courant As Double
                    Dim delta_courant As Double
                    Dim delta_max As Double = 0
                    Dim n As Integer
                    For n = 1 To listpts.Count
                        c_courant = TabPoints(3, listpts(n).get_id)
                        delta_courant = TabPoints(7, listpts(n).get_id) * Eng * (1 - c_courant)
                        If c_courant < cmin Then cmin = c_courant
                        If delta_courant > delta_max Then delta_max = delta_courant
                    Next
                    c_courant = TabVertexDouble(0, i)
                    delta_courant = TabVertexDouble(1, i) * Eng * (1 - c_courant)
                    If c_courant < cmin Or delta_courant > delta_max Then inserer = True
                End If
                If inserer Then
                    cpt = cpt + 1
                    pt1 = New point_grille(TabVertex(0, i), TabVertex(1, i), TabVertex(2, i), cpt)
                    grill.inserer(pt1)


                    ReDim Preserve TabPoints(8, cpt)
                    ReDim Preserve tabpointsface(cpt)
                    ReDim Preserve tabpointsedge(cpt)

                    TabPoints(0, cpt) = TabVertex(0, i)
                    TabPoints(1, cpt) = TabVertex(1, i)
                    TabPoints(2, cpt) = TabVertex(2, i)
                    TabPoints(3, cpt) = TabVertexDouble(0, i)
                    TabPoints(4, cpt) = 0
                    TabPoints(7, cpt) = TabVertexDouble(1, i)
                    TabPoints(8, cpt) = TabVertexDouble(2, i)
                    tabpointsedge(cpt) = Nothing
                    tabpointsface(cpt) = Nothing
                End If
            End If
        Next i
    End Sub
    Sub CreerPointsEdge(ByRef Eng As Double, ByRef grill As grille)
        'creer les point sur les aretes
        Dim cpt1 As Integer
        Dim cpt2 As Integer
        Dim vEdgeU() As Double
        Dim pas As Double
        Dim nbpas As Integer
        Dim points() As Double
        Dim swedge As SldWorks.Edge
        Dim longueur As Double
        Dim pasmax As Double
        Dim vfaceadj As Object
        Dim pt1 As point_grille
        Dim inserer As Boolean


        For cpt2 = 0 To UBound(TabEdgeDouble, 2)
            If TabEdgeDouble(0, cpt2) < 1 Then
                swedge = TabEdge(cpt2)
                vEdgeU = swedge.GetCurveParams2
                longueur = GetEdgeLenght(swedge)
                pasmax = distance_entre_points(Eng, TabEdgeDouble(0, cpt2), TabEdgeDouble(1, cpt2), TabEdgeDouble(2, cpt2), 0.15)

                nbpas = 3 * Math.Max(2, Math.Floor(longueur / pasmax - 0.0001) + 1)
                pas = (vEdgeU(7) - vEdgeU(6)) / nbpas


                For cpt1 = 0 To nbpas
                    points = swedge.Evaluate(vEdgeU(6) + pas * cpt1)
                    Dim listpts As New Collection
                    grill.rechercher(points(0), points(1), points(2), 0.5 * pasmax, listpts)
                    inserer = False
                    If listpts.Count = 0 Then
                        inserer = True
                    Else
                        Dim cmin As Double = 1
                        Dim c_courant As Double
                        Dim delta_courant As Double
                        Dim delta_max As Double = 0
                        Dim i As Integer
                        For i = 1 To listpts.Count
                            c_courant = TabPoints(3, listpts(i).get_id)
                            delta_courant = TabPoints(7, listpts(i).get_id) * Eng * (1 - c_courant)
                            If c_courant < cmin Then cmin = c_courant
                            If delta_courant > delta_max Then delta_max = delta_courant
                        Next
                        c_courant = TabEdgeDouble(0, cpt2)
                        delta_courant = TabEdgeDouble(1, cpt2) * Eng * (1 - c_courant)
                        If c_courant < cmin Or delta_courant > delta_max Then inserer = True
                    End If
                    If inserer Then
                        cpt = cpt + 1
                        pt1 = New point_grille(points(0), points(1), points(2), cpt)
                        grill.inserer(pt1)


                        ReDim Preserve TabPoints(8, cpt)
                        ReDim Preserve tabpointsface(cpt)
                        ReDim Preserve tabpointsedge(cpt)

                        TabPoints(0, cpt) = points(0)
                        TabPoints(1, cpt) = points(1)
                        TabPoints(2, cpt) = points(2)
                        TabPoints(3, cpt) = TabEdgeDouble(0, cpt2)
                        TabPoints(4, cpt) = 1
                        TabPoints(5, cpt) = vEdgeU(6) + pas * cpt1
                        TabPoints(7, cpt) = TabEdgeDouble(1, cpt2)
                        TabPoints(8, cpt) = TabEdgeDouble(2, cpt2)
                        tabpointsedge(cpt) = swedge
                        tabpointsface(cpt) = Nothing
                    End If
                Next cpt1
            End If
        Next cpt2
    End Sub
    Sub CreerPointsFace(ByRef Eng As Double, ByRef grill As grille)
        'creer les points sur les faces
        Dim cpt1 As Integer
        Dim cpt2 As Integer
        Dim cpt3 As Integer
        Dim swsurf As SldWorks.Surface
        Dim vFaceUV() As Double
        Dim vSurfParam() As Double
        Dim nbpasU As Integer
        Dim nbpasV As Integer
        Dim pasU As Double
        Dim PasV As Double
        Dim pasmax As Double
        Dim points() As Double
        Dim swface As SldWorks.Face2
        Dim vUVlong() As Double
        Dim vbbox() As Double
        Dim j As Integer
        Dim inserer As Boolean

        For cpt3 = 0 To UBound(TabFaceDouble, 2)
            If TabFaceDouble(0, cpt3) < 1 Then

                swface = Tabface(cpt3)
                swsurf = swface.GetSurface

                Dim pt1 As point_grille

                vFaceUV = swface.GetUVBounds
                vSurfParam = swsurf.Parameterization

                vUVlong = GetUVLong(swface)
                pasmax = distance_entre_points(Eng, TabFaceDouble(0, cpt3), TabFaceDouble(1, cpt3), TabFaceDouble(2, cpt3), 0.15)

                nbpasU = 3 * Math.Max(2, Math.Floor(vUVlong(0) / pasmax - 0.0001) + 1)
                nbpasV = 3 * Math.Max(2, Math.Floor(vUVlong(1) / pasmax - 0.0001) + 1)


                pasU = (vFaceUV(1) - vFaceUV(0)) / nbpasU
                PasV = (vFaceUV(3) - vFaceUV(2)) / nbpasV


                For cpt1 = 0 To nbpasU
                    For cpt2 = 0 To nbpasV
                        points = swsurf.Evaluate((vFaceUV(0) + pasU * cpt1), (vFaceUV(2) + PasV * cpt2), 0, 0)
                        If PointIsInFace(swface, points) = True Then
                            Dim listpts As New Collection
                            grill.rechercher(points(0), points(1), points(2), 0.5 * pasmax, listpts)
                            inserer = False
                            If listpts.Count = 0 Then
                                inserer = True
                            Else
                                Dim cmin As Double = 1
                                Dim c_courant As Double
                                Dim delta_courant As Double
                                Dim delta_max As Double = 0
                                Dim i As Integer
                                For i = 1 To listpts.Count
                                    c_courant = TabPoints(3, listpts(i).get_id)
                                    delta_courant = TabPoints(7, listpts(i).get_id) * Eng * (1 - c_courant)
                                    If c_courant < cmin Then cmin = c_courant
                                    If delta_courant > delta_max Then delta_max = delta_courant
                                Next
                                c_courant = TabFaceDouble(0, cpt3)
                                delta_courant = TabFaceDouble(1, cpt3) * Eng * (1 - c_courant)
                                If c_courant < cmin Or delta_courant > delta_max Then inserer = True
                            End If
                            If inserer Then
                                cpt = cpt + 1
                                pt1 = New point_grille(points(0), points(1), points(2), cpt)
                                grill.inserer(pt1)


                                ReDim Preserve TabPoints(8, cpt)
                                ReDim Preserve tabpointsface(cpt)
                                ReDim Preserve tabpointsedge(cpt)

                                TabPoints(0, cpt) = points(0)
                                TabPoints(1, cpt) = points(1)
                                TabPoints(2, cpt) = points(2)
                                TabPoints(3, cpt) = TabFaceDouble(0, cpt3)
                                TabPoints(4, cpt) = 2
                                TabPoints(5, cpt) = (vFaceUV(0) + pasU * cpt1)
                                TabPoints(6, cpt) = (vFaceUV(2) + PasV * cpt2)
                                TabPoints(7, cpt) = TabFaceDouble(1, cpt3)
                                TabPoints(8, cpt) = TabFaceDouble(2, cpt3)
                                tabpointsface(cpt) = swface
                                tabpointsedge(cpt) = Nothing
                            End If
                        End If
                    Next cpt2
                Next cpt1
            End If
        Next cpt3
    End Sub
    Sub CreerPointsVolume(ByRef Eng As Double, ByRef nbcouches As Integer, ByRef grill As grille)
        'creer les points dans le volume
        Dim cpt1 As Integer
        Dim Cpt2 As Integer = cpt

        For cpt1 = 1 To Cpt2
            Select Case TabPoints(4, cpt1)
                Case 0
                    PointVolumeVertex(TabPoints(0, cpt1), TabPoints(1, cpt1), TabPoints(2, cpt1), Eng, TabPoints(3, cpt1), nbcouches, grill)
                Case 1
                    PointVolumeEdge(TabPoints(0, cpt1), TabPoints(1, cpt1), TabPoints(2, cpt1), tabpointsedge(cpt1), Eng, TabPoints(3, cpt1), nbcouches, grill)
                Case 2
                    PointVolumeFace(TabPoints(0, cpt1), TabPoints(1, cpt1), TabPoints(2, cpt1), tabpointsface(cpt1), Eng, TabPoints(3, cpt1), nbcouches, grill)
            End Select
        Next
    End Sub
    Sub fichiertxt(ByRef Eng As Double, ByVal path As String)
        'ecriture du fichier texte
        Dim cpt1 As Long
        'Dim path As String
        Dim dg As Double
        'path = swModel.GetPathName()
        'path = Left(path, Len(path) - 12)
        Dim ligne_txt As String

        Dim fichier As StreamWriter = File.CreateText(path)
        'MsgBox(path)
        ligne_txt = CStr(TabPoints(0, 0)) & " " & CStr(TabPoints(1, 0)) & " " & CStr(TabPoints(2, 0)) & " " & CStr(TabPoints(3, 0)) & " " & CStr(TabPoints(4, 0)) & " " & CStr(TabPoints(5, 0))
        fichier.WriteLine(Replace(ligne_txt, ",", "."))
        ligne_txt = Str(Eng)
        fichier.WriteLine(Replace(ligne_txt, ",", "."))
        For cpt1 = 1 To cpt
            ligne_txt = CStr(TabPoints(0, cpt1)) & " " & CStr(TabPoints(1, cpt1)) & " " & CStr(TabPoints(2, cpt1)) & " " & CStr(TabPoints(3, cpt1)) & " " & CStr(TabPoints(7, cpt1)) & " " & CStr(TabPoints(8, cpt1))
            fichier.WriteLine(Replace(ligne_txt, ",", "."))
        Next cpt1
        fichier.Close()
    End Sub
    Sub montrerpoints()
        'montre les points d'echantillonnage
        Dim cpt1 As Long
        Dim points As SldWorks.SketchPoint

        swModel.SetAddToDB(True)
        swModel.Insert3DSketch2(False)

        For cpt1 = 1 To cpt
            points = swModel.CreatePoint2(TabPoints(0, cpt1), TabPoints(1, cpt1), TabPoints(2, cpt1))
        Next cpt1

        swModel.SetAddToDB(False)
        swModel.Insert3DSketch2(True)
        'MsgBox("points créés")
        swModel.EditRebuild3()
    End Sub
    Sub PointVolumeFace(ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef swface As SldWorks.Face2, ByRef Eng As Double, ByRef coeff As Double, ByRef nbcouches As Integer, ByVal grill As grille)
        'direction des points dans le volume pour les faces
        Dim i As Integer
        Dim j As Integer
        Dim N1(2) As Double
        Dim minusN1(2) As Double
        Dim P(2) As Double
        Dim Pi(2) As Double
        Dim Ci As Double
        Dim di As Double = 0
        Dim rdi As Double
        Dim lst As New Collection
        Dim pt1 As point_grille
        Dim vardi As Double
        Dim ParamFonction() As Double
        Dim F As Integer = 1
        Dim intvl As Integer

        P(0) = x : P(1) = y : P(2) = z
        N1 = getNormatAtPoint(P, swface)
        N1 = Vecteur_Unitaire(N1)
        minusN1(0) = -N1(0) : minusN1(1) = -N1(1) : minusN1(2) = -N1(2)
        Pointsvolume(coeff, Eng, nbcouches, P, minusN1, grill)

    End Sub
    Sub PointVolumeEdge(ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef swedge As SldWorks.Edge, ByRef Eng As Double, ByRef coeff As Double, ByRef nbcouches As Integer, ByVal grill As grille)
        'direction des points dans le volume pour les aretes
        Dim i As Integer
        Dim j As Integer
        Dim P(2) As Double
        Dim vfaceadj As Object
        Dim swface1 As SldWorks.Face2
        Dim swface2 As SldWorks.Face2
        Dim N1(2) As Double
        Dim N2(2) As Double
        Dim Phi As Double
        Dim nbline As Integer
        Dim gama As Double
        Dim Vi(2) As Double
        Dim Face1bool As Boolean
        Dim Face2bool As Boolean

        P(0) = x : P(1) = y : P(2) = z
        vfaceadj = swedge.GetTwoAdjacentFaces2
        swface1 = vfaceadj(0)
        swface2 = vfaceadj(1)

        Face1bool = faceIsAlreadyRepear(swface1)
        Face2bool = faceIsAlreadyRepear(swface2)

        N1 = getNormatAtPoint(P, swface1) : N1 = Vecteur_Unitaire(N1)
        N2 = getNormatAtPoint(P, swface2) : N2 = Vecteur_Unitaire(N2)

        N1(0) = -N1(0) : N1(1) = -N1(1) : N1(2) = -N1(2)
        N2(0) = -N2(0) : N2(1) = -N2(1) : N2(2) = -N2(2)

        Phi = GetAngle(swedge, swface1, swface2)

        Dim V() As Double = Produitvectoriel(N1, N2) : V = Vecteur_Unitaire(V)
        Dim S1() As Double = Produitvectoriel(V, N1) : S1 = Vecteur_Unitaire(S1)
        Dim S2() As Double = Produitvectoriel(N2, V) : S2 = Vecteur_Unitaire(S2)

        If Phi > 180 Then
            S1(0) = -S1(0) : S1(1) = -S1(1) : S1(2) = -S1(2)
            S2(0) = -S2(0) : S2(1) = -S2(1) : S2(2) = -S2(2)
        End If

        If Face1bool = False And Face2bool = False Then
            nbline = Int(Phi / 45)
            If nbline > 0 Then
                gama = Phi / (nbline + 1)
                Dim detA As Double = S1(0) * (N1(1) * V(2) - V(1) * N1(2)) - N1(0) * (S1(1) * V(2) - V(1) * S1(2)) + V(0) * (S1(1) * N1(2) - N1(1) * S1(2))
                For i = 1 To nbline
                    Vi(0) = Math.Cos(i * gama * 3.14 / 180) * (N1(1) * V(2) - V(1) * N1(2)) - Math.Sin(i * gama * 3.14 / 180) * (S1(1) * V(2) - V(1) * S1(2)) : Vi(0) = Vi(0) / detA
                    Vi(1) = -Math.Cos(i * gama * 3.14 / 180) * (N1(0) * V(2) - V(0) * N1(2)) + Math.Sin(i * gama * 3.14 / 180) * (S1(0) * V(2) - V(0) * S1(2)) : Vi(1) = Vi(1) / detA
                    Vi(2) = Math.Cos(i * gama * 3.14 / 180) * (N1(0) * V(1) - V(0) * N1(1)) - Math.Sin(i * gama * 3.14 / 180) * (S1(0) * V(1) - V(0) * S1(1)) : Vi(2) = Vi(2) / detA
                    Pointsvolume(coeff, Eng, nbcouches, P, Vi, grill)
                Next
            End If
            Pointsvolumeface(coeff, Eng, nbcouches, P, S2, grill, swface2)
            Pointsvolumeface(coeff, Eng, nbcouches, P, S1, grill, swface1)
        Else
            If Face1bool = True Then
                Pointsvolume(coeff, Eng, nbcouches, P, N1, grill)
            End If
            If Face2bool = True Then
                Pointsvolume(coeff, Eng, nbcouches, P, N2, grill)
            End If
        End If

    End Sub
    Sub PointVolumeVertex(ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Eng As Double, ByRef coeff As Double, ByRef nbcouches As Integer, ByVal grill As grille)
        'direction des points dans le volume pour les sommets
        Dim vedge As Object
        Dim xyz(2) As Double
        Dim swedge As SldWorks.Edge
        Dim Cprm() As Double
        Dim i As Integer
        Dim Strpt(2) As Double
        Dim Endpt(2) As Double

        vedge = swbody.GetEdges
        xyz(0) = x : xyz(1) = y : xyz(2) = z
        For i = 0 To swbody.GetEdgeCount - 1
            swedge = vedge(i)
            Cprm = swedge.GetCurveParams2
            Strpt(0) = Cprm(0) : Strpt(1) = Cprm(1) : Strpt(2) = Cprm(2)
            Endpt(0) = Cprm(3) : Endpt(1) = Cprm(4) : Endpt(2) = Cprm(5)
            If PointEgale(xyz, Strpt) Or PointEgale(xyz, Endpt) Then
                If EdgeIsRepair(swedge) = True Then
                    PointVolumeEdge(x, y, z, swedge, Eng, coeff, nbcouches, grill)
                End If
            End If
        Next i
    End Sub
    Sub Pointsvolume(ByRef coeff As Double, ByRef Eng As Double, ByRef nbcouches As Integer, ByRef P() As Double, ByRef dir() As Double, ByVal grill As grille)
        'creer les points dans le volume dans la direction donnée
        'objectif: pas de points dans le volume pour une fonction linéaire de Eni à Eng sur la taile de la zone d'influence du point de surface
        Dim ci As Double
        Dim di As Double
        Dim Vardi As Double
        Dim rdi As Double
        Dim rd As Double
        Dim j As Integer
        Dim Pi(2) As Double
        Dim lst As New Collection
        Dim pt1 As point_grille
        Dim Paramfonction() As Double
        Dim param As Double
        Dim F As Integer = 1
        Dim intvl As Integer
        Dim lambda As Double
        Dim Dface As Double
        Dim Dmax As Double
        Dim swface As SldWorks.Face2


        swface = GetFirstIntersectFace(dir, P)
        If Not swface Is Nothing Then
            Dface = DistPointFace(P, dir, swface)
        Else
            Dface = 0
        End If

        If Dface <> 0 Then
            Dmax = Math.Min(nbcouches * Eng * (1 - coeff), Dface)

            'départ au point di=0,
            For j = 0 To 2
                Pi(j) = P(j)
            Next j


            Paramfonction = FonctionVolume(0, coeff, F)
            Vardi = (nbcouches * Eng * (1 - coeff)) * 0.01

            While di < Dmax And ci < 0.95

                ci = Paramfonction(0)
                lambda = Math.Min(10, Math.Max(0.1, Math.Abs(Paramfonction(1)))) '+-lambda=pente locale de la courbe, limite inférieur--> pas de zones d'influences infinies, limte sup--» pas de zones microsopiques(discontinuitées)
                rd = di / (nbcouches * Eng * (1 - coeff))

                For j = 0 To 2
                    Pi(j) = P(j) + di * dir(j)
                Next j

                If IsInBodyBox(Pi) = True Then
                    If grill.chercher(Pi(0), Pi(1), Pi(2), Vardi / 2) = False Then
                        cpt = cpt + 1
                        pt1 = New point_grille(Pi(0), Pi(1), Pi(2), cpt)
                        grill.inserer(pt1)

                        ReDim Preserve TabPoints(8, cpt)
                        TabPoints(0, cpt) = Pi(0)
                        TabPoints(1, cpt) = Pi(1)
                        TabPoints(2, cpt) = Pi(2)
                        TabPoints(3, cpt) = ci
                        TabPoints(4, cpt) = 3
                        TabPoints(5, cpt) = 1 / lambda
                    End If
                End If

                param = 0

                While param < 0.1 And di < Dmax 'Compare la courbe théorique avec la droite issue du dernier pt, de courbe lambda, et avance jusqu'a un écart abs de 0.1

                    di = di + Vardi
                    rdi = di / (nbcouches * Eng * (1 - coeff))
                    Paramfonction = FonctionVolume(rdi, coeff, F)
                    param = Math.Abs(Paramfonction(0) - ci - lambda * (rdi - rd))

                End While

            End While
        End If
    End Sub
    Sub Pointsvolumeface(ByRef coeff As Double, ByRef Eng As Double, ByRef nbcouches As Integer, ByRef P() As Double, ByRef dir() As Double, ByVal grill As grille, ByRef swface As SldWorks.Face2)
        'Cette sous routine génére des points dans le volume qui se retrouvent en fait sur une face
        Dim ci As Double
        Dim di As Double
        Dim Vardi As Double
        Dim rdi As Double
        Dim j As Integer
        Dim Pi(2) As Double
        Dim lst As New Collection
        Dim pt1 As point_grille
        Dim Paramfonction() As Double
        Dim param As Double
        Dim F As Integer = 1
        Dim intvl As Integer
        Dim Dmax As Double
        Dim lambda As Double
        Dim rd As Double
        Dmax = nbcouches * Eng * (1 - coeff)

            For j = 0 To 2
                Pi(j) = P(j)
            Next j

        Paramfonction = FonctionVolume(0, coeff, F)
        Vardi = (nbcouches * Eng * (1 - coeff)) * 0.01

        While di < Dmax And ci < 0.95

            'Mémorise pt placé:

            ci = Paramfonction(0)
            lambda = Math.Min(10, Math.Max(0.1, Math.Abs(Paramfonction(1)))) '+-lambda=pente locale de la courbe, limite inférieur--> pas de zones d'influences infinies, limte sup--» pas de zones microsopiques(discontinuitées)
            rd = di / (nbcouches * Eng * (1 - coeff))

            For j = 0 To 2
                Pi(j) = P(j) + di * dir(j)
            Next j

            If IsInBodyBox(Pi) = True Then
                If grill.chercher(Pi(0), Pi(1), Pi(2), Vardi / 2) = False Then
                    If PointIsInFace(swface, Pi) = True Then
                        cpt = cpt + 1
                        pt1 = New point_grille(Pi(0), Pi(1), Pi(2), cpt)
                        grill.inserer(pt1)

                        ReDim Preserve TabPoints(8, cpt)
                        TabPoints(0, cpt) = Pi(0)
                        TabPoints(1, cpt) = Pi(1)
                        TabPoints(2, cpt) = Pi(2)
                        TabPoints(3, cpt) = ci
                        TabPoints(4, cpt) = 3 'on pourrait mettre 4 mais en vérité ils se trouvent sur une face--Je mets 3 car points qui servent à suivre une fonctionnelle
                        TabPoints(5, cpt) = 1 / lambda 'lambda=pente locale de la courbe
                    End If
                End If
            End If

            Paramfonction(2) = 0

            param = 0

            While param < 0.1 And di < Dmax 'Compare la courbe théorique avec la droite issue du dernier pt, de courbe lambda, et avance jusqu'a un écart de 0.1

                di = di + Vardi
                rdi = di / (nbcouches * Eng * (1 - coeff))
                Paramfonction = FonctionVolume(rdi, coeff, F)
                param = Math.Abs(Paramfonction(0) - ci - lambda * (rdi - rd))

            End While

        End While
    End Sub
    Sub lire_fichier_ech(ByRef path As String)
        Dim fichier As StreamReader = New StreamReader(path)
        Dim line As String
        Dim Carray() As String
        Dim xyz(,) As Double
        Dim cptpoints As Long = 0

        'les deux première ligne du fichier ne contienne pas de points d'échantillonnage
        line = fichier.ReadLine
        line = fichier.ReadLine
        line = fichier.ReadLine

        Do
            ReDim Preserve xyz(2, cptpoints)
            Carray = line.Split(Chr(32))
            xyz(0, cptpoints) = CDbl(Carray(0))
            xyz(1, cptpoints) = CDbl(Carray(1))
            xyz(2, cptpoints) = CDbl(Carray(2))
            cptpoints = cptpoints + 1
            line = fichier.ReadLine()
        Loop Until line Is Nothing

        fichier.Close()

        Dim cpt1 As Long
        Dim points As SldWorks.SketchPoint

        swModel.SetAddToDB(True)
        swModel.Insert3DSketch2(False)

        For cpt1 = 0 To cptpoints - 1
            points = swModel.CreatePoint2(xyz(0, cpt1), xyz(1, cpt1), xyz(2, cpt1))
        Next cpt1

        swModel.SetAddToDB(False)
        swModel.Insert3DSketch2(True)
        swModel.EditRebuild3()


    End Sub
    Function distance_entre_points(ByVal eng As Double, ByVal coef As Double, ByVal lmbd As Double, ByVal courbure As Double, ByVal erreur As Double) As Double
        Dim rmax As Double

        If courbure <= 0 Then
            rmax = erreur
        End If

        If courbure > 0 Then
            rmax = -0.05 * (Math.Sqrt(1 - 40 * courbure * erreur * (erreur - 1)) - 1) / ((erreur - 1) * courbure)
        End If

        'If courbure < 0 Then
        '    rmax = 0.05 * (Math.Sqrt(40 * courbure * erreur * (erreur - 1) + 1) + 20 * erreur * courbure - 1) / (erreur * courbure)
        'End If

        Return 2 * rmax * lmbd * eng * (1 - coef)

    End Function

    Function get_edge_lenght(ByRef swedge As SldWorks.Edge, ByVal t1 As Double, ByVal t2 As Double) As Double
        Dim curve As SldWorks.Curve
        Dim curveparam() As Double
        Dim cpt As Integer
        Dim cpt1 As Integer
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm, courb_rm As Double
        Dim longueur As Double
        Dim Nb_pas As Integer
        Dim pas As Double
        Dim ti As Double
        Dim tip1 As Double
        Dim parametre_au_point() As Double
        Dim tgauss1 As Double
        Dim tgauss2 As Double
        Dim cprim1 As Double
        Dim cprim2 As Double

        Nb_pas = 10
        longueur = 0

        curveparam = swedge.GetCurveParams2()
        curve = swedge.GetCurve()

        If (t1 <= curveparam(6)) Then t1 = curveparam(6)
        If (t2 >= curveparam(7)) Then t2 = curveparam(7)

        pas = (t2 - t1) / Nb_pas
        ti = t1

        For cpt1 = 0 To Nb_pas - 1

            tip1 = ti + pas
            tgauss1 = ((1 / Math.Sqrt(3) + 1) * ti + (-1 / Math.Sqrt(3) + 1) * tip1) / 2
            tgauss2 = ((-1 / Math.Sqrt(3) + 1) * ti + (1 / Math.Sqrt(3) + 1) * tip1) / 2

            parametre_au_point = curve.Evaluate(tgauss1)
            cprim1 = Math.Sqrt(parametre_au_point(3) * parametre_au_point(3) + parametre_au_point(4) * parametre_au_point(4) + parametre_au_point(5) * parametre_au_point(5))

            parametre_au_point = curve.Evaluate(tgauss2)
            cprim2 = Math.Sqrt(parametre_au_point(3) * parametre_au_point(3) + parametre_au_point(4) * parametre_au_point(4) + parametre_au_point(5) * parametre_au_point(5))

            longueur = longueur + (tip1 - ti) / 2 * (cprim1 + cprim2)

            ti = ti + pas
        Next

        Return longueur

    End Function

    Function get_edge_plane_lenght(ByRef swedge As SldWorks.Edge, ByRef n() As Double) As Double
        ' donne la longueur d'une arête, projettée selon le plan normal à un vecteur donné
        Dim curve As SldWorks.Curve
        Dim curveparam() As Double
        Dim cpt As Integer
        Dim cpt1 As Integer
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm, courb_rm As Double
        Dim longueur As Double
        Dim Nb_pas As Integer
        Dim pas As Double
        Dim ti As Double
        Dim tip1 As Double
        Dim parametre_au_point() As Double
        Dim tgauss1 As Double
        Dim tgauss2 As Double
        Dim cprim1 As Double
        Dim cprim2 As Double
        Dim u(2) As Double
        Dim v(2) As Double
        Dim b As Double
        Dim c As Double
        Dim delta As Double
        Dim t1 As Double
        Dim t2 As Double

        Nb_pas = 15
        longueur = 0

        curveparam = swedge.GetCurveParams2()
        curve = swedge.GetCurve()

        t1 = curveparam(6)
        t2 = curveparam(7)

        pas = (t2 - t1) / Nb_pas
        ti = t1

        For cpt1 = 0 To Nb_pas - 1
            ti = t1 + cpt1 * pas
            tip1 = ti + pas
            tgauss1 = ((1 / Math.Sqrt(3) + 1) * ti + (-1 / Math.Sqrt(3) + 1) * tip1) / 2
            tgauss2 = ((-1 / Math.Sqrt(3) + 1) * ti + (1 / Math.Sqrt(3) + 1) * tip1) / 2

            parametre_au_point = curve.Evaluate(tgauss1)
            u(0) = parametre_au_point(3)
            u(1) = parametre_au_point(4)
            u(2) = parametre_au_point(5)
            cprim1 = Produit_scalaire(Vecteur_Unitaire(Produitvectoriel(Produitvectoriel(n, u), n)), u)


            parametre_au_point = curve.Evaluate(tgauss2)
            u(0) = parametre_au_point(3)
            u(1) = parametre_au_point(4)
            u(2) = parametre_au_point(5)
            cprim2 = Produit_scalaire(Vecteur_Unitaire(Produitvectoriel(Produitvectoriel(n, u), n)), u)

            longueur = longueur + pas / 2 * (cprim1 + cprim2)
        Next

        Return longueur

    End Function
    Function get_edge_plane_lenght(ByRef swedge As SldWorks.Edge, ByRef n() As Double, ByVal t1 As Double, ByVal t2 As Double) As Double
        ' donne la longueur d'une arête, projettée selon le plan normal à un vecteur donné
        Dim curve As SldWorks.Curve
        Dim curveparam() As Double
        Dim cpt As Integer
        Dim cpt1 As Integer
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm, courb_rm As Double
        Dim longueur As Double
        Dim Nb_pas As Integer
        Dim pas As Double
        Dim ti As Double
        Dim tip1 As Double
        Dim parametre_au_point() As Double
        Dim tgauss1 As Double
        Dim tgauss2 As Double
        Dim cprim1 As Double
        Dim cprim2 As Double
        Dim u(2) As Double
        Dim v(2) As Double
        Dim b As Double
        Dim c As Double
        Dim delta As Double


        Nb_pas = 15
        longueur = 0


        curveparam = swedge.GetCurveParams2()
        curve = swedge.GetCurve()

        If (t1 <= curveparam(6)) Then t1 = curveparam(6)
        If (t2 >= curveparam(7)) Then t2 = curveparam(7)

        pas = (t2 - t1) / Nb_pas
        ti = t1

        For cpt1 = 0 To Nb_pas - 1
            ti = t1 + cpt1 * pas
            tip1 = ti + pas
            tgauss1 = ((1 / Math.Sqrt(3) + 1) * ti + (-1 / Math.Sqrt(3) + 1) * tip1) / 2
            tgauss2 = ((-1 / Math.Sqrt(3) + 1) * ti + (1 / Math.Sqrt(3) + 1) * tip1) / 2

            parametre_au_point = curve.Evaluate(tgauss1)
            u(0) = parametre_au_point(3)
            u(1) = parametre_au_point(4)
            u(2) = parametre_au_point(5)
            cprim1 = Produit_scalaire(Vecteur_Unitaire(Produitvectoriel(Produitvectoriel(n, u), n)), u)


            parametre_au_point = curve.Evaluate(tgauss2)
            u(0) = parametre_au_point(3)
            u(1) = parametre_au_point(4)
            u(2) = parametre_au_point(5)
            cprim2 = Produit_scalaire(Vecteur_Unitaire(Produitvectoriel(Produitvectoriel(n, u), n)), u)

            longueur = longueur + pas / 2 * (cprim1 + cprim2)
        Next

        Return longueur

    End Function

    Function get_loop_plane_area(ByRef swloop As SldWorks.Loop2, ByRef ns() As Double) As Double
        ' donne l'aire délimité par une boucle donnée, projettée selon le plan normal à un vecteur donné
        Dim swedge As SldWorks.Edge
        Dim ledge As Object
        Dim curve As SldWorks.Curve
        Dim curveparam() As Double
        Dim cpt As Integer
        Dim cpt1 As Integer
        Dim div As Double
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm, courb_rm As Double
        Dim surface As Double
        Dim Nb_pas As Integer = 20
        Dim pas As Double = 0
        Dim t1 As Double
        Dim t2 As Double
        Dim ti As Double
        Dim tip1 As Double
        Dim v(2) As Double
        Dim n1(2) As Double
        Dim n2(2) As Double
        Dim phi1(2) As Double
        Dim phi2(2) As Double
        Dim xyz() As Double
        Dim lgi As Double
        Dim tgauss1 As Double
        Dim tgauss2 As Double
        Dim phi(2) As Double
        Dim t(2) As Double
        Dim i As Integer
        Dim nb_edge As Integer
        Dim pt(2) As Double
        Dim curvparmip1
        Dim dpt As Double
        Dim sens As Integer ' sens de parcous de la première arête
        Dim sensi As Integer
        Dim f1 As Double
        Dim f2 As Double
        Dim dl As Double

        ledge = swloop.GetEdges
        swedge = ledge(0)
        curveparam = swedge.GetCurveParams2()
        v = swedge.Evaluate(curveparam(6))
        t(0) = v(3) : t(1) = v(4) : t(2) = v(5)
        phi = Produitvectoriel(ns, t)

        phi = Vecteur_Unitaire(phi)

        nb_edge = swloop.GetEdgeCount
        For cpt = 0 To nb_edge - 1
            sens = 1
            If cpt <> 0 Then pt = swedge.Evaluate(t2)
            swedge = ledge(cpt)
            curveparam = swedge.GetCurveParams2()
            curve = swedge.GetCurve()
            t1 = curveparam(6)
            t2 = curveparam(7)
            If cpt = 0 Then
                If nb_edge > 1 Then
                    swedge = ledge(cpt + 1)
                    curvparmip1 = swedge.GetCurveParams2()
                    dpt = Math.Sqrt((curveparam(0) - curvparmip1(0)) ^ 2 + (curveparam(1) - curvparmip1(1)) ^ 2 + (curveparam(2) - curvparmip1(2)) ^ 2)
                    If dpt > 0.01 * GetEdgeLenght(swedge) Then
                        sens = -1
                        t1 = curveparam(7)
                        t2 = curveparam(6)
                    End If
                    swedge = ledge(cpt)
                End If
            Else
                dpt = Math.Sqrt((curveparam(0) - pt(0)) ^ 2 + (curveparam(1) - pt(1)) ^ 2 + (curveparam(2) - pt(2)) ^ 2)
                If dpt > 0.01 * GetEdgeLenght(swedge) Then
                    sens = -1
                    t1 = curveparam(7)
                    t2 = curveparam(6)
                End If
            End If
            pas = (t2 - t1) / Nb_pas
            ti = t1

            For cpt1 = 0 To Nb_pas - 1
                ti = t1 + cpt1 * pas
                tip1 = ti + pas
                tgauss1 = ((1 / Math.Sqrt(3) + 1) * ti + (-1 / Math.Sqrt(3) + 1) * tip1) / 2
                tgauss2 = ((-1 / Math.Sqrt(3) + 1) * ti + (1 / Math.Sqrt(3) + 1) * tip1) / 2

                v = swedge.Evaluate(tgauss1)
                t(0) = -sens * v(3) : t(1) = -sens * v(4) : t(2) = -sens * v(5)
                n1 = Produitvectoriel(ns, t)
                '              n1 = Vecteur_Unitaire(n1)

                phi1(0) = phi(0) * Produit_scalaire(v, phi)
                phi1(1) = phi(1) * Produit_scalaire(v, phi)
                phi1(2) = phi(2) * Produit_scalaire(v, phi)

                v = swedge.Evaluate(tgauss2)
                t(0) = -sens * v(3) : t(1) = -sens * v(4) : t(2) = -sens * v(5)
                n2 = Produitvectoriel(ns, t)
                '                n2 = Vecteur_Unitaire(n2)

                phi2(0) = phi(0) * Produit_scalaire(v, phi)
                phi2(1) = phi(1) * Produit_scalaire(v, phi)
                phi2(2) = phi(2) * Produit_scalaire(v, phi)

                f1 = Produit_scalaire(phi1, n1)
                f2 = Produit_scalaire(phi2, n2)

                '               dl = get_edge_plane_lenght(swedge, ns, ti, tip1)

                surface = surface + (f1 + f2) * pas / 2
            Next cpt1
        Next cpt
        Return Math.Abs(surface)

    End Function

    Function GetAnglem(ByRef swedge As SldWorks.Edge, ByRef swface1 As SldWorks.Face2, ByRef swface2 As SldWorks.Face2, ByVal opt As String, ByRef tm As Double) As Double
        'donne l'angle matiere maximum ou minimum sur une arête, ainsi que le parametre de position du point du maximum (ou minimum)

        Dim vEdgeparam As Object
        Dim swcurve As SldWorks.Curve
        Dim xyz As Object
        Dim tmin As Double
        Dim tmax As Double
        Dim t1 As Double
        Dim t2 As Double
        Dim angle As Double
        Dim dangle As Double
        Dim t As Double
        Dim dt As Double
        Dim pas As Double
        Dim cpt As Integer
        Dim Nb_pas As Integer = 15
        Dim anglemin As Double = 360
        Dim anglemax As Double = 0
        Dim data(Nb_pas, 1) As Double
        Dim a1 As Double
        Dim a2 As Double
        Dim danglemin1 As Double = 1000
        Dim danglemin2 As Double = 1000
        Dim i As Integer = 0


        vEdgeparam = swedge.GetCurveParams2
        swcurve = swedge.GetCurve
        t1 = vEdgeparam(6)
        t2 = vEdgeparam(7)

        pas = (t2 - t1) / (Nb_pas - 1)
        For cpt = 0 To Nb_pas
            t = t1 + (cpt - 1) * pas
            a1 = GetAngle(swedge, swface1, swface2, pararam_cycliques(t, t1, t2))
            a2 = GetAngle(swedge, swface1, swface2, pararam_cycliques(t + pas, t1, t2))
            dangle = (a2 - a1) / pas
            angle = (a2 + a1) / 2
            data(cpt, 0) = dangle
            data(cpt, 1) = pararam_cycliques(t + pas / 2, t1, t2)
            If angle <= anglemin + 0.001 Then anglemin = angle : tmin = t
            If angle >= anglemax - 0.001 Then anglemax = angle : tmax = t
        Next
        While Math.Abs(danglemin1) > 0.1 And Math.Abs(danglemin2) > 0.1 And i < 20
            For cpt = 0 To Nb_pas - 1
                If data(cpt, 0) * data(cpt + 1, 0) <= 0.0001 Then
                    If (data(cpt + 1, 0) - data(cpt, 0) <> 0) Then
                        If (Math.Abs(data(cpt + 1, 1) - data(cpt, 1)) > pas) Then
                            t = -data(cpt, 0) / (data(cpt + 1, 0) - data(cpt, 0)) * (data(cpt + 1, 1) - data(cpt, 1) + t2 - t1) + data(cpt, 1)
                        Else
                            t = -data(cpt, 0) / (data(cpt + 1, 0) - data(cpt, 0)) * (data(cpt + 1, 1) - data(cpt, 1)) + data(cpt, 1)
                        End If
                        t = pararam_cycliques(t, t1, t2)
                        dangle = (GetAngle(swedge, swface1, swface2, t + Math.Min(t2 - t, pas / 10)) - GetAngle(swedge, swface1, swface2, t - Math.Min(t - t1, pas / 10))) / (Math.Min(t2 - t, pas / 10) + Math.Min(t - t1, pas / 10))
                        data(cpt, 0) = dangle
                        data(cpt, 1) = t
                    Else
                        t = data(cpt, 1)
                    End If

                    angle = GetAngle(swedge, swface1, swface2, t)
                    If angle <= anglemin + 0.001 Then anglemin = angle : tmin = t : If Math.Abs(data(cpt, 0)) < Math.Abs(danglemin1) Then danglemin1 = data(cpt, 0)
                    If angle >= anglemax - 0.001 Then anglemax = angle : tmax = t : If Math.Abs(data(cpt, 0)) < Math.Abs(danglemin2) Then danglemin2 = data(cpt, 0)
                End If
            Next cpt
            i = i + 1
        End While
        If opt = "min" Then tm = tmin : GetAnglem = anglemin
        If opt = "max" Then tm = tmax : GetAnglem = anglemax

    End Function
    Function pararam_cycliques(ByVal u As Double, ByRef u1 As Double, ByRef u2 As Double) As Double
        If (u < u1) Then
            pararam_cycliques = u2 - u1 + u
        Else
            If (u > u2) Then
                pararam_cycliques = u1 + u - u2
            Else
                pararam_cycliques = u
            End If
        End If
    End Function
    Function anglemin_face_arete(ByRef swface As SldWorks.Face2, ByRef swedge As SldWorks.Edge, ByRef vertex As SldWorks.Vertex) As Double
        'Donne l'angle entre une face et une arete, au point commun face-arete, angle orienté de telle facon qu'il soit minimum
        Dim n(2) As Double
        Dim u() As Double
        Dim angle As Double
        Dim pt() As Double
        Dim t As Double
        Dim phi As Double
        Dim v(2) As Double

        pt = vertex.GetPoint
        n = getNormatAtPoint(pt, swface)
        n = Vecteur_Unitaire(n)
        t = swedge.GetParameter(pt(0), pt(1), pt(2))
        u = swedge.Evaluate(t)
        v(0) = u(3) : v(1) = u(4) : v(2) = u(5)

        v = Vecteur_Unitaire(v)
        If (Produit_scalaire(n, v) < 0) Then v(0) = -v(0) : v(1) = -v(1) : v(2) = -v(2)
        n = Produitvectoriel(n, v)
        phi = 180 / Math.PI * Math.Asin(Math.Sqrt(n(0) ^ 2 + n(1) ^ 2 + n(2) ^ 2))
        v(0) = -v(0) : v(1) = -v(1) : v(2) = -v(2)
        anglemin_face_arete = phi
    End Function
    Function anglemin_face_arete(ByRef swface As SldWorks.Face2, ByRef swedge As SldWorks.Edge, ByRef pt() As Double, ByRef v() As Double) As Double
        'Donne l'angle entre une face et une arete, au point commun face-arete, angle orienté de telle facon qu'il soit minimum, et le vecteur porté par l'arete rentrant dans la matière
        Dim n(2) As Double
        Dim u() As Double
        Dim angle As Double
        Dim t() As Double
        Dim phi As Double

        n = getNormatAtPoint(pt, swface)
        n = Vecteur_Unitaire(n)
        t = swedge.GetParameter(pt(0), pt(1), pt(2))
        If t(1) Then
            u = swedge.Evaluate(t(0))
        Else
            MsgBox("erreur ! fonction anglemin_face_arete")
        End If

        v(0) = u(3) : v(1) = u(4) : v(2) = u(5)

        v = Vecteur_Unitaire(v)
        If (Produit_scalaire(n, v) < 0) Then v(0) = -v(0) : v(1) = -v(1) : v(2) = -v(2)
        n = Produitvectoriel(n, v)
        phi = 180 / Math.PI * Math.Asin(Math.Sqrt(n(0) ^ 2 + n(1) ^ 2 + n(2) ^ 2))
        v(0) = -v(0) : v(1) = -v(1) : v(2) = -v(2)
        anglemin_face_arete = phi
    End Function

    Function direction_retrait_matiere(ByRef swloop As SldWorks.Loop2, ByRef swfaceref As SldWorks.Face2) As Double()
        'donne le vecteur de direction d'un retrait de matière à partir d'une boucle interne à une face, surlaquelle on a détecté un retrait de matière
        Dim swface As SldWorks.Face2
        Dim swfacetmp As SldWorks.Face2
        Dim swfacetmp2 As SldWorks.Face2
        Dim swsurface As SldWorks.Surface
        Dim cpt1 As Integer
        Dim cpt2 As Integer
        Dim swedge As SldWorks.Edge
        Dim swedgetmp As SldWorks.Edge
        Dim swedgetmp1 As SldWorks.Edge
        Dim swedgetmp2 As SldWorks.Edge
        Dim vedge As Object
        Dim vedgetmp1 As Object
        Dim vedgetmp2 As Object
        Dim vface As Object
        Dim vfacetmp As Object
        Dim i As Integer
        Dim lg As Double
        Dim n(2) As Double
        Dim nmin(2) As Double
        Dim nmax(2) As Double
        Dim area As Double
        Dim angle_min As Double
        Dim angle_max As Double
        Dim angle As Double
        Dim angletmp As Double
        Dim t As Double
        Dim curvparm1() As Double
        Dim curvparm2() As Double
        Dim pt(2) As Double
        Dim multiface As Boolean = False


        angle_min = 180 : angle_max = 0
        nmin(0) = 0 : nmin(1) = 0 : nmin(2) = 0 : nmax(0) = 0 : nmax(1) = 0 : nmax(2) = 0

        vedge = swloop.GetEdges

        For cpt1 = 0 To swloop.GetEdgeCount - 1
            swedgetmp = vedge(cpt1)
            vfacetmp = swedgetmp.GetTwoAdjacentFaces
            swfacetmp = vfacetmp(0)
            If swfacetmp.IsSame(swfaceref) = True Then
                swfacetmp = vfacetmp(1)
            Else
                If vfacetmp(1).IsSame(swfaceref) = False Then
                    multiface = True
                    Continue For
                End If
            End If

            angle = GetAnglem(swedgetmp, swfaceref, swfacetmp, "min", t)
            If angle < angle_min Then angle_min = angle : nmin = Get_vect_into_mat(swedgetmp, swfacetmp, t)
            angle = GetAnglem(swedgetmp, swfaceref, swfacetmp, "max", t)
            If angle > angle_max Then angle_max = angle : nmax = Get_vect_into_mat(swedgetmp, swfacetmp, t)

            If cpt1 > 0 Then
                curvparm1 = swedgetmp.GetCurveParams2
                curvparm2 = swedgetmp2.GetCurveParams2
                lg = Math.Min(GetEdgeLenght(swedgetmp), GetEdgeLenght(swedgetmp2))
                pt(0) = curvparm1(0) : pt(1) = curvparm1(1) : pt(2) = curvparm1(2)
                If (Math.Sqrt((pt(0) - curvparm2(0)) ^ 2 + (pt(1) - curvparm2(1)) ^ 2 + (pt(2) - curvparm2(2)) ^ 2) > 0.1 * lg And Math.Sqrt((pt(0) - curvparm2(3)) ^ 2 + (pt(1) - curvparm2(4)) ^ 2 + (pt(2) - curvparm2(5)) ^ 2) > 0.1 * lg) Then pt(0) = curvparm1(3) : pt(1) = curvparm1(4) : pt(2) = curvparm1(5)
                If (Math.Sqrt((pt(0) - curvparm2(0)) ^ 2 + (pt(1) - curvparm2(1)) ^ 2 + (pt(2) - curvparm2(2)) ^ 2) > 0.1 * lg And Math.Sqrt((pt(0) - curvparm2(3)) ^ 2 + (pt(1) - curvparm2(4)) ^ 2 + (pt(2) - curvparm2(5)) ^ 2) > 0.1 * lg) Then MsgBox("erreur")

                vedgetmp1 = swfacetmp.GetEdges
                For cpt2 = 0 To UBound(vedgetmp1)
                    swedgetmp1 = vedgetmp1(cpt2)
                    curvparm1 = swedgetmp1.GetCurveParams2
                    lg = GetEdgeLenght(swedgetmp1)
                    If (Math.Sqrt((pt(0) - curvparm1(0)) ^ 2 + (pt(1) - curvparm1(1)) ^ 2 + (pt(2) - curvparm1(2)) ^ 2) < 0.1 * lg Or Math.Sqrt((pt(0) - curvparm1(3)) ^ 2 + (pt(1) - curvparm1(4)) ^ 2 + (pt(2) - curvparm1(5)) ^ 2) < 0.1 * lg) Then
                        If (swedgetmp1.GetCurve.Equals(swedgetmp.GetCurve) = False) Then
                            angle = anglemin_face_arete(swfaceref, swedgetmp1, pt, n)
                            If 90 + angle > angle_max Then angle_max = 90 + angle : nmax(0) = n(0) : nmax(1) = n(1) : nmax(2) = n(2)
                            If 90 - angle < angle_min Then angle_min = 90 - angle : nmin(0) = n(0) : nmin(1) = n(1) : nmin(2) = n(2)
                        End If
                    End If
                Next cpt2
            End If

            swfacetmp2 = swfacetmp
            swedgetmp2 = swedgetmp
        Next cpt1

        If (multiface) Then
            If (90 - angle_min > angle_max - 90) Then
                n(0) = nmin(0)
                n(1) = nmin(1)
                n(2) = nmin(2)
            Else
                n(0) = nmax(0)
                n(1) = nmax(1)
                n(2) = nmax(2)
            End If
        Else
            n(0) = nmin(0) + nmax(0)
            n(1) = nmin(1) + nmax(1)
            n(2) = nmin(2) + nmax(2)
            If (n(2) + n(2) + n(2) = 0) Then MsgBox("erreur, vecteur de norme nulle")
            n = Vecteur_Unitaire(n)
        End If
        direction_retrait_matiere = n
    End Function
    Function raffinn_auto_retrait_mat(ByVal Erx_ref As Double, ByRef coef As Double, ByRef lmbd As Double, ByRef courb As Double, ByVal Dng As Double, ByVal rayon As Double, ByRef params() As Double) As Boolean
        Dim delta_ref_theo As Double
        Dim delta_ref_ptlimite As Double
        Dim Eng_ref As Double
        Dim delta As Double
        Dim Eni_ref As Double
        Dim Eni As Double
        Dim A As Double = 0.12
        Dim B As Double = 0.68
        Dim param_rm() As Double
        Dim pentelimite As Double = 0.25

        Dim x As Double
        Dim pente As Double


        Eng_ref = Dng / rayon
        If Eng_ref > 0.00001 Then

            Eni_ref = Erx_ref / (A * Math.Pow(contrainte_vm_rm_ref(0, 2, param_rm), B)) ' estimateur

            delta_ref_theo = (Math.Log(Math.Pow(Erx_ref / (A * Eng_ref), 1 / B) / (param_rm(2) * param_rm(2))) - param_rm(1)) / param_rm(2) - 1
            delta_ref_ptlimite = delta_ref_theo

            For x = 0 To 0.9 * delta_ref_theo Step delta_ref_theo / 10
                pente = (Erx_ref / (A * Math.Pow(contrainte_vm_rm_ref(x + delta_ref_theo / 10, 2, param_rm), B)) - Erx_ref / (A * Math.Pow(contrainte_vm_rm_ref(x, 2, param_rm), B))) / (delta_ref_theo / 10)
                If pente > pentelimite Then
                    delta_ref_ptlimite = (Eng_ref - Erx_ref / (A * Math.Pow(contrainte_vm_rm_ref(x, 2, param_rm), B))) / pentelimite + x
                    Exit For
                End If
            Next


            delta = Math.Max(delta_ref_theo, delta_ref_ptlimite) * rayon
            courb = Math.Min(-0.5 * (1 - 0.25 * (delta_ref_ptlimite - delta_ref_theo) / delta_ref_theo), 0)
            Eni = Eni_ref * rayon
            coef = Eni / Dng
            lmbd = delta / (Dng - Eni)
            raffinn_auto_retrait_mat = True
        Else
            raffinn_auto_retrait_mat = False
        End If
        ReDim params(1)
        params(0) = A : params(1) = B
    End Function
    Function contrainte_vm_rm_ref(ByVal x As Double, ByVal degre As Integer, ByRef param As Double()) As Double
        Dim A As Double = 1.06446
        Dim B As Double = 4.1287
        Dim C As Double = -3.46124
        Dim D As Double = -0.00946

        ' contrainte vm  du retrait de matiere de reference et ses dérivées en fct de la position / a la surface su retrait matiere
        x = x + 1
        If degre = 0 Then
            contrainte_vm_rm_ref = A + Math.Exp(B + C * x) + D * x
        Else
            If degre = 1 Then
                contrainte_vm_rm_ref = C * Math.Exp(B + C * x) + D
            Else
                If degre = 2 Then
                    contrainte_vm_rm_ref = C * C * Math.Exp(B + C * x)
                Else
                    contrainte_vm_rm_ref = 0
                End If
            End If
        End If
        ReDim param(4)
        param(0) = A : param(1) = B : param(2) = C : param(3) = D
    End Function
    Function determination_precision_retrait_mat(ByRef Eng As Double, ByRef coeff_rm As Double) As Double

        Dim swface As SldWorks.Face2
        Dim swsurface As SldWorks.Surface
        Dim swfaceref As SldWorks.Face2
        Dim swfeat As SldWorks.Feature
        Dim swloop As SldWorks.Loop2
        Dim cpt1 As Integer
        Dim cpt2 As Integer
        Dim swedge As SldWorks.Edge
        Dim swedgetmp As SldWorks.Edge
        Dim vedge As Object
        Dim vface As Object
        Dim cpt3 As Integer
        Dim cpt4 As Integer
        Dim i As Integer
        Dim swent As SldWorks.Entity
        Dim bRet As Boolean
        Dim lmbd_rm As Integer
        Dim courb_rm As Double
        Dim lg As Double
        Dim lgi As Double
        Dim angle As Double
        Dim n(2) As Double
        Dim area As Double
        Dim select_loop As Integer
        Dim t As Double
        Dim diametre As Double = 0
        Dim nb_retrait_mat As Integer = 0
        Dim param(1) As Double
        Dim Eni_moy As Double = Eng * coeff_rm
        Dim tmp() As Double

        ReDim Preserve Tabretrait_mat(0)
        Tabretrait_mat(0) = New retrait_mat(Nothing, 0)

        swfaceref = swbody.GetFirstFace
        For cpt1 = 0 To swbody.GetFaceCount - 1
            diametre = 0
            swfeat = swfaceref.GetFeature
            swsurface = swfaceref.GetSurface
            swloop = swfaceref.GetFirstLoop
            For cpt2 = 0 To swfaceref.GetLoopCount - 1
                select_loop = 0
                If swloop.IsOuter = False Then
                    vedge = swloop.GetEdges
                    For cpt3 = 0 To swloop.GetEdgeCount - 1
                        swedge = vedge(cpt3)
                        vface = swedge.GetTwoAdjacentFaces
                        swface = vface(0)
                        If swface.IsSame(swfaceref) = True Then swface = vface(1)
                        angle = GetAngle(swedge, swfaceref, swface)
                        If angle < 179 Then
                            If (select_loop = 0) Then

                                n = direction_retrait_matiere(swloop, swfaceref)
                                lg = 0
                                For cpt4 = 0 To swloop.GetEdgeCount - 1
                                    swedgetmp = vedge(cpt4)
                                    lgi = get_edge_plane_lenght(swedgetmp, n)
                                    lg = lg + lgi
                                Next cpt4
                                area = get_loop_plane_area(swloop, n)
                                diametre = 4 * area / lg
                                select_loop = 1
                            End If
                            If diametre > 0.000001 Then
                                If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
                                ReDim Preserve Tabretrait_mat(nb_retrait_mat)
                                Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swface, diametre)
                            End If
                        End If
                    Next cpt3
                Else
                    If swfeat.GetTypeName = "HoleWzd" Then
                        diametre = 0
                        Dim hole As SldWorks.WizardHoleFeatureData2
                        hole = swfeat.GetDefinition
                        Select Case hole.Type
                            Case 0, 2 To 5, 7 To 9
                                diametre = hole.Diameter
                            Case 1, 6
                                diametre = (hole.MajorDiameter - hole.MinorDiameter) / 2
                            Case 10 To 13, 22 To 24, 43
                                diametre = hole.HoleDiameter
                            Case 14 To 21, 25 To 30, 44, 45
                                diametre = hole.ThruHoleDiameter
                            Case 31, 32, 37, 38, 46, 47
                                diametre = hole.TapDrillDiameter
                            Case 33 To 36, 39 To 42, 48 To 55
                                diametre = hole.ThruTapDrillDiameter
                            Case Else
                                MsgBox("Type de trou non reconnu")
                        End Select
                        If diametre > 0.000001 Then
                            If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
                            ReDim Preserve Tabretrait_mat(nb_retrait_mat)
                            Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)

                        End If
                    Else
                        If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
                            diametre = 0
                            Dim params() As Double
                            If swsurface.Identity = 4002 Then
                                params = swsurface.CylinderParams
                                diametre = params(6) * 2
                            End If
                            If swsurface.Identity = 4003 Then
                                params = swsurface.ConeParams
                                diametre = params(6) * 2
                            End If
                            If swsurface.Identity = 4005 Then
                                params = swsurface.TorusParams
                                diametre = params(7) * 2
                            End If
                            If diametre > 0.000001 Then
                                If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
                                ReDim Preserve Tabretrait_mat(nb_retrait_mat)
                                Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)
                            End If
                        End If
                    End If
                End If
                swloop = swloop.GetNext
            Next cpt2
            swfaceref = swfaceref.GetNextFace
        Next cpt1

        If nb_retrait_mat > 0 Or Tabretrait_mat(0).diametre > 0 Then
            diametre = 0
            For cpt1 = 0 To nb_retrait_mat
                diametre = diametre + Tabretrait_mat(cpt1).diametre
            Next
            diametre = diametre / (nb_retrait_mat + 1)
            Eni_moy = 2 * Eni_moy / diametre  ' devient Eni moy reference
            raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, param)
            determination_precision_retrait_mat = Eni_moy * param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1))
            MsgBox("Pré-optimisation de maillage des caractéristiques Retraits de matière avec une précision de " & 100 * determination_precision_retrait_mat & "%")
        Else
            determination_precision_retrait_mat = 1
        End If
    End Function

    Function raffinement_retrait_matiere(ByRef Eng As Double, ByRef Erx As Double)
        Dim cpt As Integer
        Dim coeff As Double
        Dim lmbd As Double
        Dim courb As Double
        Dim tmp() As Double

        For cpt = 0 To UBound(Tabretrait_mat)
            If raffinn_auto_retrait_mat(Erx, coeff, lmbd, courb, Eng, Tabretrait_mat(cpt).diametre / 2, tmp) Then ChangeTabFace(Tabretrait_mat(cpt).face, coeff, lmbd, courb)
        Next

    End Function

End Module


REM
' on a les listes suivantes si on provient de l'icone sauvegarder pour MAGiC
' lst_AreteVolume   ' liste de SlyAreteVol:     courbes appartenant au volume
' lst_AreteCoque    ' liste de SlyAreteCoque:   courbes appartenant aux coques
' lst_AretePoutre   ' liste de SlyAretePoutre:  courbe libres (poutres)
' lst_FaceVolume    ' liste de SlyFaceVol:      faces appartenant au volume
' lst_FaceCoque     ' liste de SlyFaceCoque:    face libres (coques)
' lst_SommetVolume  ' liste de SlySommetVolume: Sommets du volume
' lst_SommetCoque   ' liste de SlySommetCoque:  sommets des coques
' lst_sommetPoutre  ' liste de SlySommetPoutre: sommets des poutres
Revision:	46
Committed:	Wed Aug 22 18:28:53 2007 UTC (17 years, 8 months ago) by bournival
File size:	124119 byte(s)
Log Message:	Ajout de la page de prÃ©-optimisation automatique et des modification que j'ai apportÃ©es.