REPOS_ERICCA/magicsld/Intersections.vb

Imports SolidWorks.Interop
Imports SolidWorks.Interop.swconst
Imports SolidWorks.Interop.swpublished

Module Intersections
    Public DefAttrInterALAL As SldWorks.AttributeDef
    Public DefAttrConditionLimite As SldWorks.AttributeDef
    Public DefAttrRCP1 As SldWorks.AttributeDef
    Public DefAttrRCCoque As SldWorks.AttributeDef
    Public DefAttrFaceInterne As SldWorks.AttributeDef
    Public DefAttrDoublon As SldWorks.AttributeDef
    Public DefAttrIgnorer As SldWorks.AttributeDef

    Public nbMinipoutre As Long


#Region "Enums"
    Public Enum typeInterPoutreVolume
        Centre = 0
        Sur_arete = 1
        Sur_sommet = 2
        Courbe = 3
    End Enum

#End Region


    Public Sub Debuter(Optional ByRef nom2 As String = "C:\Documents and Settings\Sylvain Bournival\Bureau\testMAGiC.sldprt", Optional ByVal nomFichier As String = "", Optional ByRef original As Boolean = True, Optional ByRef modifie As Boolean = True)

        ' *******
        ' quelques options de performance
        ' *******
        swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
        swModel.SetAddToDB(True)
        swModel.SetDisplayWhenAdded(False)
        ' ******
        ' fin des options de performance
        ' ******

        Memoriser3iemePoint() ' mémorise le coord system car si on découpe, sa coordonnée est perdue.
        CouperPoutres()
        Commun.GenererListes() ' va ignorer les poutres à ignorer... et ajouter les poutres coupées dans la liste.


        ' Traitement des intersection poutres-Volumes
        DetectionPoutresVolumes()
        DecouperPoutreVolume()
        ' fin traitement intersection poutres-volumes

        swModel.EditRebuild3()


        ' Traitement des intersection entre poutre et coques
        DetectionPoutresCoques()
        DecouperPoutreCoque()
        ' Fin du traitement des intersections entre poutre et coques


        ' traitement des coques-volumes
        DetectionCoqueVolume()
        DécouperCoqueVolume()
        ' fin traitement coque volume

        ' traitement des coques-coques
        DetectionCoqueCoque()
        DecouperCoqueCoque()
        '


        ' *******
        ' quelques options de performance, remettre à la position initiale
        ' *******
        swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
        swModel.SetAddToDB(False)
        swModel.SetDisplayWhenAdded(True)
        swModel.GraphicsRedraw2()
        ' ******
        ' fin des options de performance
        ' ******
        ReplacerFolder()


    End Sub


    ''' <summary>
    ''' Sub qui découpe les coques en fonction des informations placées dans le InterCoqueCoque
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DecouperCoqueCoque()
        Dim rayon As Double


        For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
            For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
                rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
                Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
                interCC.DecouperCoque(Coque, sweep)

                ' reste à retrouver les faces internes.
                interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
            Next
        Next


    End Sub

    ''' <summary>
    '''  sub qui créé une instance de la classe interCoqueCoque s'il y a une intersection de ce type
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DetectionCoqueCoque()

        Dim sketch As SldWorks.Sketch = Nothing
        Dim interCC As InterCoqueCoque = Nothing
        Dim Coque1 As SlyFaceCoque, Coque2 As SlyFaceCoque

        For i As Integer = 0 To Commun.lst_FaceCoque.Count - 2 'For Each Coque1 As SlyFaceCoque In Commun.lst_FaceCoque
            Coque1 = Commun.lst_FaceCoque.Item(i)
            For j As Integer = i + 1 To Commun.lst_FaceCoque.Count - 1 '  For Each coque2 As SlyFaceCoque In lst_FaceCoque
                Coque2 = Commun.lst_FaceCoque.Item(j)
                If DetectFaceFace(Coque2.SwFace, Coque1.SwFace, True, sketch) Then
                    ' création de l'instance de interFace-face entre coque et coque

                    interCC = New InterCoqueCoque
                    interCC.sFaceCoque1 = Coque1
                    interCC.sFaceCoque2 = Coque2
                    interCC.FaceDeSection = False
                    interCC.sketch = sketch

                    Coque1.lst_InterCoqueCoque.Add(interCC)
                    Coque2.lst_InterCoqueCoque.Add(interCC)
                End If

            Next j
        Next i

    End Sub


    Private Sub ReplacerFolder()
        ' on doit mettre les folders à la fin pour que ça marche dans MAGiC
        'Si on ne met pas les attributs à la fin on est baisé...

        Dim swFeat As SldWorks.Feature = Nothing
        Dim nomdernier As String
        Dim dansFolder As Boolean = False
        Dim i As Integer = 0
        Dim ok As Boolean = False
        Dim SelMgr As SldWorks.SelectionMgr

        'trouver le premier feature qui n'est pas un folder...
        Do Until ok
            swFeat = swModel.FeatureByPositionReverse(i)
            nomdernier = swFeat.GetTypeName

            If (nomdernier = "FtrFolder") Then
                dansFolder = Not dansFolder
            Else
                If Not dansFolder Then ok = True
            End If
            i += 1
        Loop

        nomdernier = swFeat.Name

        SelMgr = swModel.SelectionManager
        If swModel.Extension.SelectByID2("Poutres", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Poutres", nomdernier)
        If swModel.Extension.SelectByID2("Coques", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Coques", nomdernier)
        If swModel.Extension.SelectByID2("Conditions Aux Limites", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("Conditions Aux Limites", nomdernier)
        If swModel.Extension.SelectByID2("FaceInternes", "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0) Then swModel.ReorderFeature("FaceInternes", nomdernier)

    End Sub


    Public Sub RegisterAttribut()
        Static nouveau As Boolean
        'propriétés des intersections entre 2 poutres (Arete-libre Arête-libre)

        If nouveau Then Exit Sub
        Dim nom As String
        Dim retval As Boolean

        nom = "InterALAL"
        DefAttrInterALAL = swApp.DefineAttribute(nom)
        DefAttrInterALAL.AddParameter("X", swconst.swParamType_e.swParamTypeDouble, 0, 0)
        DefAttrInterALAL.AddParameter("Y", swconst.swParamType_e.swParamTypeDouble, 0, 0)
        DefAttrInterALAL.AddParameter("Z", swconst.swParamType_e.swParamTypeDouble, 0, 0)
        DefAttrInterALAL.AddParameter("T", swconst.swParamType_e.swParamTypeDouble, -1, 0)
        retval = DefAttrInterALAL.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le InterALAL")


        nom = "ConditionLimite"
        DefAttrConditionLimite = swApp.DefineAttribute(nom)
        DefAttrConditionLimite.AddParameter("CL", swconst.swParamType_e.swParamTypeString, 0, 0)
        retval = DefAttrConditionLimite.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le COndition Limite")


        DefAttrRCP1 = swApp.DefineAttribute("Poutre1")
        DefAttrRCP1.AddParameter("M", 1, 0, 0) ' 0 = double, 1 = string, 2 = integer
        DefAttrRCP1.AddParameter("S", 1, 0, 0)
        DefAttrRCP1.AddParameter("As", 0, 0, 0)
        DefAttrRCP1.AddParameter("I1", 0, 0, 0)
        DefAttrRCP1.AddParameter("I2", 0, 0, 0)
        DefAttrRCP1.AddParameter("N3", 1, 0, 0) ' le nom du troisième point
        DefAttrRCP1.AddParameter("X3", 0, 0, 0) ' le x du troisième point
        DefAttrRCP1.AddParameter("Y3", 0, 0, 0) ' le y du troisième point
        DefAttrRCP1.AddParameter("Z3", 0, 0, 0) ' le z du troisième point
        DefAttrRCP1.AddParameter("D1", 0, 0, 0)
        DefAttrRCP1.AddParameter("D2", 0, 0, 0)
        DefAttrRCP1.AddParameter("D3", 0, 0, 0)
        DefAttrRCP1.AddParameter("D4", 0, 0, 0)
        DefAttrRCP1.AddParameter("D5", 0, 0, 0)
        DefAttrRCP1.AddParameter("D6", 0, 0, 0)
        DefAttrRCP1.AddParameter("Flag", 0, 0, 0)

        retval = DefAttrRCP1.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le RCPoutre")

        DefAttrRCCoque = swApp.DefineAttribute("Coque")
        DefAttrRCCoque.AddParameter("M", 1, 0, 0) 'le matériau' 0 = double, 1 = string, 2 = integer
        DefAttrRCCoque.AddParameter("Ep", 0, 0, 0) ' épaisseur
        DefAttrRCCoque.AddParameter("Flag", 0, 0, 0) ' un flag pour les coques...
        retval = DefAttrRCCoque.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le RCCoque")

        DefAttrFaceInterne = swApp.DefineAttribute("FaceInterne")
        DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la présence de l'attribut est suffisante.
        retval = DefAttrFaceInterne.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le FaceInterne")

        DefAttrDoublon = swApp.DefineAttribute("Doublon")
        DefAttrDoublon.AddParameter("Maitre", 1, 0, 0)  ' le nom du maitre...
        DefAttrDoublon.AddParameter("Sens", 0, 0, 0)  ' -1 si dans le sens oposé
        retval = DefAttrDoublon.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le Doublon")

        nom = "Ignorer"
        DefAttrIgnorer = swApp.DefineAttribute(nom)
        DefAttrIgnorer.AddParameter("Rien", 0, 0, 0)
        retval = DefAttrIgnorer.Register()
        If retval = False Then MsgBox("Enregistrement raté pour le Ignorer")

        nouveau = True

    End Sub

    Private Sub TraiteAPAP()
        ' procédure plus utilisée.
        ' procédure qui trouve les intersections entre les poutres et qui créé un attribut contenant les informations

        ' en premier on efface les features attributs, pour ne pas avoir de doubles
        Dim feat As SldWorks.Feature
        feat = swPart.FirstFeature
        Dim nextfeat As SldWorks.Feature

        Do While Not feat Is Nothing
            If Left(feat.Name, 9) = "InterAPAP" Then
                nextfeat = feat.GetNextFeature
                swModel.Extension.SelectByID2(feat.Name, "ATTRIBUTE", 0, 0, 0, False, 0, Nothing, 0)
                swPart.EditDelete()
                feat = nextfeat
            Else
                feat = feat.GetNextFeature
            End If
        Loop
        ' faut aussi détruire les liste de points dans les poutres
        ' ce qui suit n'est pas optimisé en temps d'exécution, mais en temps de programmation  ;-)
        ' j'aurais besoin d'un trouver qui retourne le sly... en fonction d'un feature(edge)
        Dim p As SlyAretePoutre
        For Each p In lst_AretePoutre
            p.EffacerIntersection()
        Next


        '    ' fin de l'effacement des attributs
        Dim swArete1 As SldWorks.Edge
        Dim swArete2 As SldWorks.Edge
        Dim SlyArete1 As SlyAretePoutre
        Dim SlyArete2 As SlyAretePoutre

        Dim xyz() As Double = Nothing
        Dim pt As New InterPoutrePoutre
        'Dim lst_pts As New Collection
        Dim i As Long

        Dim a1 As Integer
        Dim a2 As Integer


        For a1 = 0 To lst_AretePoutre.Count - 2
            SlyArete1 = lst_AretePoutre.Item(a1)
            swArete1 = SlyArete1.swArete

            For a2 = a1 + 1 To lst_AretePoutre.Count - 1
                SlyArete2 = lst_AretePoutre.Item(a2)
                swArete2 = SlyArete2.swArete

                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...

                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
                            Case 1 ' la première courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                            Case 2 ' la seconde courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete2
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete2.AjouterPointAPAP(pt)
                                pt = Nothing
                            Case 3 ' les doux courbes sont coupées
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete2
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete2.AjouterPointAPAP(pt)
                                pt = Nothing
                        End Select
                    Next i
                End If

            Next a2
        Next a1
        pt = Nothing
    End Sub


    Public Function DetectAreteArete(ByRef swArete1 As SldWorks.Edge, ByRef swArete2 As SldWorks.Edge, ByRef xyz() As Double) As Boolean
        ' function qui détermine si 2 arêtes se touchent, si oui alors la fonction retourne vrai et le tableau XYZ contient le point d'intersection
        xyz = Nothing
        If swArete2 Is Nothing Then Exit Function
        If swArete1 Is Nothing Then Exit Function

        Dim swSommet As SldWorks.Vertex
        Dim point1 As Object  ' point début courbe 1
        Dim point2 As Object  ' point fin,  courbe 1
        Dim point3 As Object  ' point début courbe 2
        Dim point4 As Object  ' point fin,  courbe 2
        Dim swCourbe1 As SldWorks.Curve
        Dim swCourbe2 As SldWorks.Curve
        Dim vIntersectPts As Object

        swSommet = swArete1.GetStartVertex
        If swSommet Is Nothing Then ' cercle fermé
            point1 = swArete1.Evaluate(0)
            point2 = point1
        Else
            point1 = swSommet.GetPoint
            swSommet = swArete1.GetEndVertex
            point2 = swSommet.GetPoint
        End If

        swSommet = swArete2.GetStartVertex
        If swSommet Is Nothing Then
            point3 = swArete2.Evaluate(0)
            point4 = point3
        Else
            point3 = swSommet.GetPoint

            swSommet = swArete2.GetEndVertex
            point4 = swSommet.GetPoint
        End If
        swCourbe1 = swArete1.GetCurve
        swCourbe2 = swArete2.GetCurve


        vIntersectPts = swCourbe1.IntersectCurve(swCourbe2, point1, point2, point3, point4)

        Try  ' je déteste cette façon de procéder, mais il ne détecte pas que le vintersectpts est nothing, il le croit system.dbnull.  Et je ne peut comparer avec ça.
            xyz = vIntersectPts

            If Not xyz Is Nothing Then
                DetectAreteArete = True
                Dim i As Integer
                For i = 0 To ((UBound(xyz) + 1) / 4) - 1
                    Debug.Write("x" & i & " = " & xyz(i * 4) * 1000 & " mm")
                    Debug.Write("y" & i & " = " & xyz(i * 4) * 1000 & " mm")
                    Debug.Write("z" & i & " = " & xyz(i * 4) * 1000 & " mm")
                Next i
            Else
                Return False
            End If
        Catch ex As Exception
            DetectAreteArete = False
        End Try

    End Function

    Public Function DetectAreteArete(ByRef swArete1 As SldWorks.Edge, ByRef swCourbe2 As SldWorks.Curve, ByRef xyz() As Double) As Boolean
        ' function qui détermine si 2 arêtes se touchent, si oui alors la fonction retourne vrai et le tableau XYZ contient le point d'intersection
        xyz = Nothing
        If swArete1 Is Nothing Then Exit Function
        Dim swSommet As SldWorks.Vertex
        Dim point1 As Object  ' point début courbe 1
        Dim point2 As Object  ' point fin,  courbe 1
        Dim point3 As Object  ' point début courbe 2
        Dim point4 As Object  ' point fin,  courbe 2
        Dim swCourbe1 As SldWorks.Curve

        Dim vIntersectPts As Object

        swSommet = swArete1.GetStartVertex
        If swSommet Is Nothing Then ' cercle fermé
            point1 = swArete1.Evaluate(0)
            point2 = point1
        Else
            point1 = swSommet.GetPoint
            swSommet = swArete1.GetEndVertex
            point2 = swSommet.GetPoint
        End If


        If Not swCourbe2.IsTrimmedCurve Then
            Dim vP1 As Object, vP2 As Object
            vP1 = swCourbe2.Evaluate(-9000)
            vP2 = swCourbe2.Evaluate(9000)
            swCourbe2 = swCourbe2.CreateTrimmedCurve2(vP1(0), vP1(1), vP1(2), vP2(0), vP2(1), vP2(2))
        End If

        If Not swCourbe2.IsTrimmedCurve Then
            MsgBox("Ça plante, le trimmage n'a pas fonctionné...")
        End If

        Dim dpoint3 As Double, dpoint4 As Double, isClosed As Boolean, isPeriodic As Boolean
        swCourbe2.GetEndParams(dpoint3, dpoint4, isClosed, isPeriodic)

        point3 = swCourbe2.Evaluate(dpoint3)
        point4 = swCourbe2.Evaluate(dpoint4)

        swCourbe1 = swArete1.GetCurve

        vIntersectPts = swCourbe1.IntersectCurve(swCourbe2, point1, point2, point3, point4)

        Try  ' je déteste cette façon de procéder, mais il ne détecte pas que le vintersectpts est nothing, il le croit system.dbnull.  Et je ne peut comparer avec ça.
            xyz = vIntersectPts

            If Not xyz Is Nothing Then
                DetectAreteArete = True
                Dim i As Integer
                For i = 0 To ((UBound(xyz) + 1) / 4) - 1
                    Debug.Write("x" & i & " = " & xyz(i * 4) * 1000 & " mm")
                    Debug.Write("y" & i & " = " & xyz(i * 4) * 1000 & " mm")
                    Debug.Write("z" & i & " = " & xyz(i * 4) * 1000 & " mm")
                Next i
            Else
                Return False
            End If
        Catch ex As Exception
            DetectAreteArete = False
        End Try

    End Function

    Private Function isIntersect_milieu(ByRef Arete1 As SldWorks.Edge, ByRef Arete2 As SldWorks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Byte
        'procédure qui dit si les courbes s'intersectent au milieu ou à leurs point d'extrémité.
        ' 0 si les deux intersections sont sur des points
        ' 1 si la première courbe est coupée
        ' 2 si la deuxième est coupée
        ' 3 si les deux courbes sont coupées


        Dim retv As Object  ' mettre les valeurs de T dans la classe

        retv = Arete1.GetCurveParams2()  ' retv 0,1,2 point de départ, 3,4,5 point final
        If (Math.Abs(retv(0) - x) < Epsilon) And (Math.Abs(retv(1) - y) < Epsilon) And (Math.Abs(retv(2) - z) < Epsilon) Or (Math.Abs(retv(3) - x) < Epsilon) And (Math.Abs(retv(4) - y) < Epsilon) And (Math.Abs(retv(5) - z) < Epsilon) Then isIntersect_milieu = 0 Else isIntersect_milieu = 1

        retv = Arete2.GetCurveParams2()  ' retv 0,1,2 point de départ, 3,4,5 point final
        If (Math.Abs(retv(0) - x) < Epsilon) And (Math.Abs(retv(1) - y) < Epsilon) And (Math.Abs(retv(2) - z) < Epsilon) Or (Math.Abs(retv(3) - x) < Epsilon) And (Math.Abs(retv(4) - y) < Epsilon) And (Math.Abs(retv(5) - z) < Epsilon) Then isIntersect_milieu += 0 Else isIntersect_milieu += 2

    End Function


    ''' <summary>
    ''' Sub qui traite les intersections entre les Poutres et les coques
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DetectionPoutresCoques()
        '#1 on détecte les intersections, on en a 4 types, 
        ' #1a) intersection au milieu de la coque
        ' #1b) intersection sur une arête
        ' #1c) intersection sur un sommet
        ' #1d) intersection sur une certaine longueur
        ' faut également faire attention, il peut y avoir plus d'une poutre qui se rejoint à la même intersection.
        ' hypothèses: 1- les zones d'influence des poutres ne se croisent pas.
        '             2- une arête ne fait qu'une seule intersection, à un pount ou sur une ligne, mais pas à plusieurs endroits.
        '             3- une arête dont l'intersection est une courbe n'a pas d'autres intersections (pout l'instant)
        ' lorsqu'une intersection est détectée on créé une instance de la classe InterPoutreCoque 

        Dim sPoutre As SlyAretePoutre
        Dim sCoque As SlyFaceCoque
        Dim inter As InterPoutreCoque
        Dim xyz() As Double = Nothing
        Dim tipe As Byte
        Dim i As Integer
        Dim premier2 As Boolean


        For Each sCoque In lst_FaceCoque
            For Each sPoutre In lst_AretePoutre
                ' on cherche entre la coque et la poutre

                If DetectFaceArete(sPoutre.swArete, sCoque.SwFace, xyz) Then
                    For i = 0 To UBound(xyz) - 1 Step 3
                        ' trouver le tipe d'intersection...

                        Dim u() As Double
                        Dim v() As Double

                        u = sPoutre.GetOrientation(xyz(i + 0), xyz(i + 1), xyz(i + 2))
                        v = sCoque.GetNormale(xyz(i + 0), xyz(i + 1), xyz(i + 2))

                        If Math.Abs((Math.Abs(Math.Acos(Outils_Math.cosdir(u, v))) - Pi / 2)) < Epsilon Then
                            ' on est dans le même plan que la coque, on doit déterminer si on sort ou entre dans la coque.
                            Dim T As Double, T1 As Double, T2 As Double
                            Dim PointTest(2) As Double
                            T = sPoutre.GetT(xyz(i + 0), xyz(i + 1), xyz(i + 2))

                            ' on fait T + ou - 15 * epsilon.  si une valeur est dans la coque alors on considère que l'on a le type 2
                            ' on prend 15 fois epsilon car à 10, la fonction de solidworks considère que l'on est tellement près que l'on est sur la face
                            T1 = T + 15 * Epsilon
                            T2 = T - 15 * Epsilon

                            Dim effacer As Double

                            If sPoutre.Evaluer(T1, PointTest) Then
                                ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
                                If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
                                    ' on est dans la coque.
                                    If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
                                End If
                            End If

                            If sPoutre.Evaluer(T2, PointTest) Then
                                effacer = Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2))
                                If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
                                    If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
                                End If
                            End If


                            ' si tipe n'est pas à 2 alors on est par défaut à 3
                            If tipe = 0 Then tipe = 3

                        Else
                            tipe = 1 ' on va devoir couper en X
                        End If

                        inter = sCoque.AjouterInterPoutre(sPoutre, xyz, tipe)
                        sPoutre.lst_InterCoque.Add(inter)
                        tipe = 0  ' reset

                    Next i ' autre point d'intersection

                End If
                premier2 = False ' reset
            Next sPoutre
        Next sCoque
    End Sub


    ''' <summary>
    ''' Sub qui procède au découpage des coques en fonction des poutres
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DecouperPoutreCoque()
        ' #2 on procède au découpage de la face
        Dim sCoque As SlyFaceCoque
        For Each sCoque In lst_FaceCoque
            If sCoque.lst_InterPoutre.Count > 0 Then
                'sVol.chercherAttributs()
                sCoque.decouper()

                ' on met-a-jour l'attribut des conditions aux limites
                Dim attr As SldWorks.Attribute
                Dim swent As SldWorks.Entity
                Dim nom3 As String = Nothing
                Dim p As SldWorks.Parameter
                If Not sCoque.AttributCL Is Nothing Then
                    nom3 = "CL_" & sCoque.nom
                    swent = sCoque.lst_Faces.Item(1)
                    attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.

                    If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sCoque.lst_Faces.Item(1), nom3, 0, 0)
                    p = attr.GetParameter("CL")
                    p.SetStringValue(sCoque.condition)

                End If
                GererDossiers("Conditions Aux Limites", nom3)
            End If

        Next
    End Sub


    ''' <summary>
    ''' Sub qui détecte les intersections entre les faces du volume et les poutres
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DetectionPoutresVolumes()
        Dim sPoutre As SlyAretePoutre

        For Each sPoutre In lst_AretePoutre
            If Not sPoutre.IsFaceDeSection Then
                Call Intersections.GestionPoutreNormaleAvecVolume(sPoutre)
            Else
                ' la poutre est flaggée pour prendre la face de section
                Call Intersections.GestionFace_De_section(sPoutre)
            End If
        Next sPoutre
    End Sub

    ''' <summary>
    ''' Sub qui prend les intersections entre les faces et les volumes et qui coupe les volumes
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DecouperPoutreVolume()
        ' #2 on procède au découpage de la face
        Dim sVol As SlyFaceVolume

        For Each sVol In lst_FaceVolume
            If sVol.lst_InterPoutre.Count > 0 Then
                sVol.decouper()

                ' on met-a-jour l'attribut des conditions aux limites
                Dim attr As SldWorks.Attribute
                Dim swent As SldWorks.Entity
                Dim nom3 As String = Nothing
                Dim p As SldWorks.Parameter
                If Not sVol.AttributCL Is Nothing Then
                    nom3 = "CL_" & sVol.nom
                    swent = sVol.SwFace
                    attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.

                    If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sVol.SwFace, nom3, 0, 0)
                    p = attr.GetParameter("CL")
                    p.SetStringValue(sVol.condition)

                End If
                GererDossiers("Conditions Aux Limites", nom3)
            End If

        Next
    End Sub


    ''' <summary>
    ''' Sub qui gère la poutre qui a été flaggée comme ayant une face de section.  Met à jour les attributs avec les bonnes inerties et autre
    ''' </summary>
    ''' <param name="sPoutre">La poutre avec laquelle il faut travailler</param>
    ''' <remarks></remarks>
    Private Sub GestionFace_De_section(ByRef sPoutre As SlyAretePoutre)

        Dim sVol As SlyFaceVolume
        Dim swExt As SldWorks.ModelDocExtension
        Dim xyz() As Double = Nothing, xyz2() As Double = Nothing
        Dim section As Object
        Dim Face1 As SlyFaceVolume = Nothing, prop1() As Double = Nothing
        Dim Face2 As SlyFaceVolume = Nothing, prop2() As Double = Nothing
        Dim proprietes() As Double
        Dim i As Integer
        swExt = swModel.Extension

        ' 1 - Spotter la ou les faces en question
        xyz = sPoutre.GetStartPoint
        xyz2 = sPoutre.GetEndPoint
        For Each sVol In Commun.lst_FaceVolume
            If Intersections.DetectSurfaceArete(sPoutre.swArete, sVol.SwFace, Nothing) Then
                swModel.ClearSelection2(True)
                sVol.Selectionner()
                section = swExt.GetSectionProperties2(sVol.SwFace) : proprietes = section
                swModel.ClearSelection2(True)
                ' la fontion getsectionproperties renvoie des valeurs dont la précision est très douteuse...
                ' on met alors une beaucoup plus grosse tolérance...
                If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then Face1 = sVol : prop1 = proprietes
                If Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then Face2 = sVol : prop2 = proprietes
            End If
        Next

        ' si les 2 faces sont nothing, c'est que l'on a un sérieux problème...
        If Face1 Is Nothing AndAlso Face2 Is Nothing Then
            MsgBox("La poutre " & sPoutre.nom & " doit avoir au moins une face pour évaluer sa section.  Cette face n'a pas été trouvée." & vbCr & vbCr & " Vérifiez que: " & vbCr & "    - Un sommet de la poutre repose sur le centre de gravité d'une face" & vbCr & "    - Que l'arète de la poutre est perpendiculaire à la face" & vbCr & "    - Que la face est plane " & vbCr & "    - Je crois avoir tout couvert..." & vbCr & vbCr & "  La poutre a problème a été colorée en rouge.", MsgBoxStyle.Critical, "Impossible de trouver la face représentant la section")
            Dim e As New SuperArete(sPoutre.swArete, True)
            e.Colorer(3, 1, 0, 0)
            sPoutre.Selectionner()
            Exit Sub
        End If


        ' 2 - s'assurer que:
        ' 2.1 les 2 faces sont identiques (si 2 faces)
        If Face1 IsNot Nothing And Face2 IsNot Nothing Then
            If Not Math.Abs(prop1(1) - prop2(1)) < 0.0000001 Then
                Dim chaine As String
                chaine = "Les 2 faces ne sont pas identiques... "
                For i = 0 To 14
                    chaine = chaine & vbCr & i & " - " & Format(prop1(i), "0.000E+00") & "  " & Format(prop2(i), "0.000E+00")
                Next i
                MsgBox(chaine)
            End If
        End If
        ' 2.2 le centroide est au point d'intersection
        ' déjà fait
        ' 2.3 la face est plane
        If Face1 IsNot Nothing Then
            If Not (Face1.estPlan Xor Face1.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
                MsgBox("La face 1 n'est pas plane!")
                Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
            End If
        End If
        If Face2 IsNot Nothing Then
            If Not (Face2.estPlan Xor Face2.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
                MsgBox("La face 2 n'est pas plane!")
                Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
            End If
        End If


        ' 2.4 les face sont perpendiculaire aux point d'intersection
        Dim u() As Double
        Dim v() As Double
        Dim angle As Double
        If Face1 IsNot Nothing Then
            u = Face1.GetNormaleSurface(prop1(2), prop1(3), prop1(4))
            v = sPoutre.GetOrientation(prop1(2), prop1(3), prop1(4))
            angle = Outils_Math.Angle2Vecteurs(u, v)
            If Not (Math.Abs(angle - Pi) < (100 * Epsilon)) And Not (angle < 0.005) Then
                MsgBox("La poutre n'est pas perpendiculaire à la face1")
                Err.Raise(514, "GestionFace_de_section - Dans intersection.vb", "Ne peut pas traiter une poutre dont la face de base n'est pas perpendiculaire")
            End If
        End If

        If Face2 IsNot Nothing Then
            u = Face2.GetNormaleSurface(prop2(2), prop2(3), prop2(4))
            v = sPoutre.GetOrientation(prop2(2), prop2(3), prop2(4))
            angle = Outils_Math.Angle2Vecteurs(u, v)
            If Not (Math.Abs(angle - Pi) < (100 * Epsilon)) And Not (angle < Epsilon) Then
                MsgBox("La poutre n'est pas perpendiculaire à la face2")
                Err.Raise(514, "GestionFace_de_section - Dans intersection.vb", "Ne peut pas traiter une poutre dont la face de base n'est pas perpendiculaire")
            End If
        End If

        ' 3 - trouver l'inertie et l'aire, placer le point 3 de façon cohérente, updater l'attribut.
        Dim Nom3 As String

        Commun.MettreUnPoint(prop1(2) + prop1(18) / 1000, prop1(3) + prop1(19) / 1000, prop1(4) + prop1(20) / 1000, True)
        Nom3 = RealConstant.RCCode.Creation3iemePoint(1)
        sPoutre.SetAttributsDePoutre(False, Nom3, , , prop1(13), prop1(14), prop1(1), , , , , , , 1)

        ' 4 créer une nouvelle instance de la classe interFacePoutre de tipe 5
        Dim inter As New InterPoutreVolume
        Dim inter2 As New InterPoutreVolume
        If Face1 IsNot Nothing Then
            xyz(0) = prop1(2) : xyz(1) = prop1(3) : xyz(2) = prop1(4)
            inter = Face1.AjouterInterPoutre(sPoutre, xyz, 5)
            sPoutre.lst_InterCoque.Add(inter)
        End If

        If Face2 IsNot Nothing Then
            xyz(0) = prop2(2) : xyz(1) = prop2(3) : xyz(2) = prop2(4)
            inter2 = Face2.AjouterInterPoutre(sPoutre, xyz, 5)
            sPoutre.lst_InterCoque.Add(inter2)
        End If

    End Sub


    ''' <summary>
    ''' Sub qui trouve les intersections entre les poutres et les faces de volumes et qui créé une instance de la classe d'intersection
    ''' </summary>
    ''' <param name="sPoutre">La poutre avec laquelle il faut trouver les intersections</param>
    ''' <remarks></remarks>
    Private Sub GestionPoutreNormaleAvecVolume(ByRef sPoutre As SlyAretePoutre)
        Dim inter As InterPoutreVolume
        Dim xyz() As Double = Nothing
        Dim tipe As Byte
        Dim i As Integer
        Dim premier2 As Boolean
        Dim sVol As SlyFaceVolume

        For Each sVol In lst_FaceVolume


            ' on cherche entre la coque et la poutre


            If DetectFaceArete(sPoutre.swArete, sVol, xyz) Then

                For i = 0 To UBound(xyz) - 1 Step 3
                    ' trouver le tipe d'intersection...

                    Dim u() As Double
                    Dim v() As Double

                    u = sPoutre.GetOrientation(xyz(i + 0), xyz(i + 1), xyz(i + 2))
                    v = sVol.GetNormale(xyz(i + 0), xyz(i + 1), xyz(i + 2))

                    ' ***** ici, différencier entre coque et volume ****
                    If Math.Abs((Math.Abs(Math.Acos(Outils_Math.cosdir(u, v))) - Pi / 2)) < Epsilon Then
                        ' on est dans le même plan que la coque, on doit déterminer si on sort ou entre dans la coque.
                        Dim T As Double, T1 As Double, T2 As Double
                        Dim PointTest(2) As Double
                        T = sPoutre.GetT(xyz(i + 0), xyz(i + 1), xyz(i + 2))

                        ' on fait T + ou - 15 * epsilon.  si une valeur est dans la coque alors on considère que l'on a le type 2
                        ' on prend 15 fois epxilon car à 10, la fonction de solidworks considère que l'on est tellement près que l'on est sur la face
                        T1 = T + 15 * Epsilon
                        T2 = T - 15 * Epsilon

                        Dim effacer As Double

                        If sPoutre.Evaluer(T1, PointTest) Then
                            ' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
                            If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
                                ' on est dans la coque.
                                If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
                            End If
                        End If

                        If sPoutre.Evaluer(T2, PointTest) Then
                            effacer = Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2))
                            If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
                                If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
                            End If
                        End If

                        ' si tipe n'est pas à 2 alors on est par défaut à 3
                        If tipe = 0 Then tipe = 3

                    Else
                        tipe = 1 ' on va devoir couper en X
                    End If

                    inter = sVol.AjouterInterPoutre(sPoutre, xyz, tipe)
                    sPoutre.lst_InterCoque.Add(inter)
                    tipe = 0  ' reset

                Next i ' autre point d'intersection

            End If
            premier2 = False ' reset

        Next sVol
    End Sub


    'Private Function DetectFaceArete(ByRef swCurve As SldWorks.Curve, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
    '    ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
    '    Dim vCurveParam As Object
    '    Dim swSurf As SldWorks.Surface
    '    Dim vCurveBounds As Object, vPointArray As Object, vTArray As Object, vUVArray As Object
    '    Dim nCurveBounds(5) As Double
    '    Dim bRet As Boolean
    '    Dim i As Integer

    '    swSurf = swFace.GetSurface

    '    ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
    '    If swCurve.IsLine Then
    '        Dim startp(2) As Double
    '        Dim endp(2) As Double
    '        Dim vStart As Object
    '        Dim vEnd As Object

    '        vCurveParam = swCurve.LineParams()
    '        startp(0) = vCurveParam(0)
    '        startp(1) = vCurveParam(1)
    '        startp(2) = vCurveParam(2)
    '        vStart = startp

    '        endp(0) = vCurveParam(3)
    '        endp(1) = vCurveParam(4)
    '        endp(2) = vCurveParam(5)
    '        vEnd = endp

    '        Dim retval As Object
    '        Dim valeur As Double
    '        Dim dimension As Integer
    '        Dim ordre As Integer
    '        Dim nbpoints As Integer
    '        Dim periodique As Integer

    '        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
    '        Dim knots(3) As Double
    '        Dim ctrlPoints(5) As Double

    '        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)

    '        '3 - on créé une spline dans le modeleur


    '        Dim modeler As SldWorks.Modeler
    '        modeler = swApp.GetModeler
    '        Dim props As Object
    '        Dim dProps(1) As Double
    '        Dim vKnots As Object, vCtrlPoints As Object

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

    '        swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
    '        ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
    '    End If


    '    For i = 0 To 5
    '        nCurveBounds(i) = vCurveParam(i)
    '    Next i

    '    vCurveBounds = nCurveBounds
    '    bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)

    '    Dim Pts() As Double
    '    Dim PointsTemp() As Double
    '    Dim j As Integer

    '    Pts = vPointArray

    '    If UBound(Pts) < 1 Then Return False
    '    ' ATTENTION, le point n'est pas nécessairement dans la face
    '    For i = 0 To UBound(Pts) - 1 Step 3
    '        If Commun.Distance(swFace, Pts(i + 0), Pts(i + 1), Pts(i + 2)) < Epsilon Then
    '            ReDim Preserve PointsTemp(j + 2)
    '            PointsTemp(j) = Pts(i + 0)
    '            PointsTemp(j + 1) = Pts(i + 1)
    '            PointsTemp(j + 2) = Pts(i + 2)
    '            j += 3
    '        End If
    '    Next

    '    xyz = PointsTemp
    '    If xyz Is Nothing Then Return False
    '    If UBound(xyz) > 0 Then Return True


    'End Function

    Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
        ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection

        Dim P1 As Object = Nothing, p2 As Object = Nothing
        If swModel.ClosestDistance(swArete, swFace, P1, p2) > Epsilon Then Return False

        Dim swCurve As SldWorks.Curve
        Dim swSurf As SldWorks.Surface
        Dim vCurveParam As Object

        Dim vCurveBounds As Object, vPointArray As Object = Nothing, vTArray As Object = Nothing, vUVArray As Object = Nothing
        Dim nCurveBounds(5) As Double
        Dim bRet As Boolean
        Dim i As Integer

        '1 - on va chercher la courbe et la surface
        swCurve = swArete.GetCurve
        swSurf = swFace.GetSurface


        ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
        vCurveParam = swArete.GetCurveParams2
        If swCurve.IsLine Then
            Dim startp(2) As Double
            Dim endp(2) As Double
            Dim vStart As Object
            Dim vEnd As Object


            startp(0) = vCurveParam(0)
            startp(1) = vCurveParam(1)
            startp(2) = vCurveParam(2)
            vStart = startp

            endp(0) = vCurveParam(3)
            endp(1) = vCurveParam(4)
            endp(2) = vCurveParam(5)
            vEnd = endp

            Dim retval As Object

            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
            Dim knots(3) As Double
            Dim ctrlPoints(5) As Double

            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)

            '3 - on créé une spline dans le modeleur


            Dim modeler As SldWorks.Modeler
            modeler = swApp.GetModeler
            Dim props As Object
            Dim dProps(1) As Double
            Dim vKnots As Object, vCtrlPoints As Object

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

            swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
            ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
        End If


        For i = 0 To 5
            nCurveBounds(i) = vCurveParam(i)
        Next i

        vCurveBounds = nCurveBounds
        bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)

        Dim Pts() As Double
        Dim PointsTemp() As Double = Nothing
        Dim j As Integer

        Pts = vPointArray

        If UBound(Pts) < 1 Then Return False
        ' ATTENTION, le point n'est pas nécessairement dans la face
        For i = 0 To UBound(Pts) - 1 Step 3
            If Commun.Distance(swFace, Pts(i + 0), Pts(i + 1), Pts(i + 2)) < Epsilon Then
                ReDim Preserve PointsTemp(j + 2)
                PointsTemp(j) = Pts(i + 0)
                PointsTemp(j + 1) = Pts(i + 1)
                PointsTemp(j + 2) = Pts(i + 2)
                j += 3
            End If
        Next

        xyz = PointsTemp
        If xyz Is Nothing Then Return False
        If UBound(xyz) > 0 Then Return True

    End Function


    Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double) As Boolean
        Dim swface As SldWorks.Face2
        Dim surarete As Boolean
        For Each swface In Slyface.lst_Faces
            If DetectFaceArete(swArete, swface, xyz) Then
                Dim vEdges As Object
                Dim Arete As SldWorks.Edge
                Dim inu() As Double = Nothing

                vEdges = swface.GetEdges

                For Each Arete In vEdges
                    If DetectAreteArete(Arete, swArete, inu) Then
                        ' on a un type d'intersection entre une face et une arète...
                        Dim swSurf As SldWorks.Surface
                        Dim retval As Object
                        Dim v(2) As Double
                        Dim u(2) As Double
                        Dim angle As Double
                        swSurf = swface.GetSurface
                        retval = swSurf.EvaluateAtPoint(xyz(0), xyz(1), xyz(2))
                        ' les 3 premiers de retval sont la normale...
                        v(0) = retval(0) : v(1) = retval(1) : v(2) = retval(2)

                        retval = swArete.GetParameter(inu(0), inu(1), inu(2))
                        retval = swArete.Evaluate(retval(0))
                        u(0) = retval(3) : u(1) = retval(4) : u(2) = retval(5)
                        angle = Outils_Math.Angle2Vecteurs(u, v)
                        MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense)

                        If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
                            Return True
                        Else
                            surarete = True
                        End If
                    End If
                Next


                If Not surarete Then Return True Else Return False
            End If
        Next
    End Function


    Private Function DetectSurfaceArete(ByRef swArete As SldWorks.Edge, ByRef swFace As SldWorks.Face2, ByRef xyz() As Double) As Boolean
        ' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
        Dim swCurve As SldWorks.Curve
        Dim swSurf As SldWorks.Surface
        Dim vCurveParam As Object

        Dim vCurveBounds As Object, vPointArray As Object = Nothing, vTArray As Object = Nothing, vUVArray As Object = Nothing
        Dim nCurveBounds(5) As Double
        Dim bRet As Boolean
        Dim i As Integer

        '1 - on va chercher la courbe et la surface
        swCurve = swArete.GetCurve
        swSurf = swFace.GetSurface


        ' 2- on va chercher les paramètres de la spline avec Curve::ConvertLineToBcurve
        vCurveParam = swArete.GetCurveParams2
        If swCurve.IsLine Then
            Dim startp(2) As Double
            Dim endp(2) As Double
            Dim vStart As Object
            Dim vEnd As Object


            startp(0) = vCurveParam(0)
            startp(1) = vCurveParam(1)
            startp(2) = vCurveParam(2)
            vStart = startp

            endp(0) = vCurveParam(3)
            endp(1) = vCurveParam(4)
            endp(2) = vCurveParam(5)
            vEnd = endp

            Dim retval As Object

            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
            Dim knots(3) As Double
            Dim ctrlPoints(5) As Double

            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)

            '3 - on créé une spline dans le modeleur


            Dim modeler As SldWorks.Modeler
            modeler = swApp.GetModeler
            Dim props As Object
            Dim dProps(1) As Double
            Dim vKnots As Object, vCtrlPoints As Object

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

            swCurve = modeler.CreateBsplineCurve(props, vKnots, vCtrlPoints)
            ' 4 - on a une spline, on peut utiliser la fonction IntersectCurve
        End If


        For i = 0 To 5
            nCurveBounds(i) = vCurveParam(i)
        Next i

        vCurveBounds = nCurveBounds
        bRet = swSurf.IntersectCurve(swCurve, vCurveBounds, vPointArray, vTArray, vUVArray)

        Dim Pts() As Double
        Dim PointsTemp() As Double = Nothing
        Dim j As Integer

        Pts = vPointArray

        If UBound(Pts) < 1 Then Return False

        For i = 0 To UBound(Pts) - 1 Step 3
            ReDim Preserve PointsTemp(j + 2)
            PointsTemp(j) = Pts(i + 0)
            PointsTemp(j + 1) = Pts(i + 1)
            PointsTemp(j + 2) = Pts(i + 2)
            j += 3
        Next i

        xyz = PointsTemp
        If xyz Is Nothing Then Return False
        If UBound(xyz) > 0 Then Return True


    End Function


    Private Function DetectSommetArete(ByRef swsommet As SldWorks.Vertex, ByRef swArete As SldWorks.Edge, ByRef xyz() As Double) As Boolean
        Dim x As Double, y As Double, z As Double
        Dim vPoint As Object
        Dim vPoint2 As Object
        vPoint = swsommet.GetPoint

        x = vPoint(0)
        y = vPoint(1)
        z = vPoint(2)

        vPoint2 = swArete.GetClosestPointOn(x, y, z)
        If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
            ReDim xyz(2)
            xyz(0) = x
            xyz(1) = y
            xyz(2) = z
            DetectSommetArete = True
        End If

    End Function


    Private Function DetectSommetArete(ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef swArete As SldWorks.Edge) As Byte
        Dim vPoint As Object
        Dim vPoint2 As Object

        vPoint2 = swArete.GetClosestPointOn(x, y, z)
        If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
            DetectSommetArete = 1

            ' maintenant on cherche à savoir si ca touche au premier sommet de l'arrête. 
            vPoint = swArete.GetCurveParams2()

            If Math.Abs(vPoint(0) - x) < Epsilon And Math.Abs(vPoint(1) - y) < Epsilon And Math.Abs(vPoint(2) - z) < Epsilon Then DetectSommetArete = 2
            If Math.Abs(vPoint(3) - x) < Epsilon And Math.Abs(vPoint(4) - y) < Epsilon And Math.Abs(vPoint(5) - z) < Epsilon Then DetectSommetArete = 2

        End If

    End Function

    Private Function DetectSommetArete(ByRef swArete2som As SldWorks.Edge, ByRef swArete As SldWorks.Edge, ByRef xyz() As Double, Optional ByRef ret As Byte = 0) As Boolean
        ' ret:  1 = sur premier sommet, 2 = sur dernier sommet
        Dim x As Double, y As Double, z As Double
        Dim vPoint As Object
        Dim vPoint2 As Object
        Dim swSommet As SldWorks.Vertex

        swSommet = swArete2som.GetStartVertex
        If IsNothing(swSommet) Then Exit Function ' on a un cercle...


        vPoint = swSommet.GetPoint

        x = vPoint(0)
        y = vPoint(1)
        z = vPoint(2)

        vPoint2 = swArete.GetClosestPointOn(x, y, z)
        If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
            ReDim xyz(2)
            xyz(0) = x
            xyz(1) = y
            xyz(2) = z
            DetectSommetArete = True
            ret += 1
        End If

        swSommet = swArete2som.GetEndVertex
        vPoint = swSommet.GetPoint

        x = vPoint(0)
        y = vPoint(1)
        z = vPoint(2)

        vPoint2 = swArete.GetClosestPointOn(x, y, z)
        If Math.Abs(vPoint2(0) - x) < Epsilon And Math.Abs(vPoint2(1) - y) < Epsilon And Math.Abs(vPoint2(2) - z) < Epsilon Then
            ReDim xyz(2)
            xyz(0) = x
            xyz(1) = y
            xyz(2) = z
            DetectSommetArete = True
            ret += 2
        End If


    End Function

    Private Sub Memoriser3iemePoint()
        Dim poutre As SlyAretePoutre
        Dim attr As SldWorks.Attribute
        Dim p As SldWorks.Parameter
        Dim swEnt As SldWorks.Entity


        For Each poutre In Commun.lst_AretePoutre
            Dim xyz() As Double
            Dim nom As String = Nothing

            If Not poutre.IsFaceDeSection Then
                xyz = poutre.GetPoint3(nom)

                poutre.X3 = xyz(0)
                poutre.Y3 = xyz(1)
                poutre.Z3 = xyz(2)

                swEnt = poutre.swArete

                attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
                p = attr.GetParameter("N3")

                p = attr.GetParameter("X3")
                p.SetDoubleValue2(poutre.X3, 2, "")

                p = attr.GetParameter("Y3")
                p.SetDoubleValue2(poutre.Y3, 2, "")

                p = attr.GetParameter("Z3")
                p.SetDoubleValue2(poutre.Z3, 2, "")
            End If
        Next poutre

    End Sub


    Private Sub CouperPoutres()

        ' procédure qui trouve les intersections entre les poutres et qui les coupe.
        ' à la fin on a plus d'intersections entre les poutres (ailleur qu'un sommet)

        Dim swArete1 As SldWorks.Edge
        Dim swArete2 As SldWorks.Edge
        Dim SlyArete1 As SlyAretePoutre
        Dim SlyArete2 As SlyAretePoutre

        Dim xyz() As Double = Nothing
        Dim pt As New InterPoutrePoutre
        'Dim lst_pts As New Collection
        Dim i As Long

        Dim a1 As Integer
        Dim a2 As Integer


        For a1 = 0 To lst_AretePoutre.Count - 2
            SlyArete1 = lst_AretePoutre.Item(a1)
            swArete1 = SlyArete1.swArete

            For a2 = a1 + 1 To lst_AretePoutre.Count - 1
                SlyArete2 = lst_AretePoutre.Item(a2)
                swArete2 = SlyArete2.swArete

                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...

                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
                            Case 1 ' la première courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                            Case 2 ' la seconde courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete2
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete2.AjouterPointAPAP(pt)
                                pt = Nothing
                            Case 3 ' les doux poutres sont coupées
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete2
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete2.AjouterPointAPAP(pt)
                                pt = Nothing
                        End Select
                    Next i
                End If

            Next a2

            Dim SlyArete3 As SlyAreteCoque
            For a2 = 0 To lst_AreteCoque.Count - 1
                SlyArete3 = lst_AreteCoque.Item(a2)
                swArete2 = SlyArete3.swArete

                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...

                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
                            Case 1 ' la première courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                                ' seul la coque est coupée, elle sera découpée anyway.
                            Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                        End Select
                    Next i
                End If
            Next a2

            Dim slyarete4 As SlyAreteVol
            For a2 = 0 To lst_AreteVolume.Count - 1
                slyarete4 = lst_AreteVolume.Item(a2)
                swArete2 = slyarete4.swArete

                If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
                    For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...

                        Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
                            Case 1 ' la première courbe est coupée
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                            Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
                                pt = New InterPoutrePoutre
                                pt.Arete = swArete1
                                pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
                                SlyArete1.AjouterPointAPAP(pt)
                                pt = Nothing
                        End Select
                    Next i
                End If
            Next a2


        Next a1
        pt = Nothing


        'toutes les poutres ont des points où elles doivent être coupées
        ' il suffit de couper.
        ' en réalité on suppress et on créé 2 ou plus courbes par dessus.
        Dim attr As SldWorks.Attribute
        Dim swEnt As SldWorks.Entity

        For Each SlyArete1 In lst_AretePoutre
            If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
                '1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre


                ' si c'est une droite
                If SlyArete1.IsLine Then
                    Dim Pts(,) As Double
                    Dim swSketch As SldWorks.Sketch
                    ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)

                    SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
                    Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))

                    For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
                        Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
                        Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
                        Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
                        Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
                    Next i

                    Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
                    SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
                    Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))

                    ' faut ordonner les points selon T...
                    Dim j As Integer
                    Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
                    For i = 0 To max - 2
                        For j = 0 To max - i - 1
                            If Pts(3, j) > Pts(3, j + 1) Then
                                T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
                                Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
                                Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
                            End If
                        Next j
                    Next i


                    For i = 0 To UBound(Pts, 2) - 1
                        swModel.Insert3DSketch2(False)
                        swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
                        swSketch = swModel.GetActiveSketch2
                        swModel.Insert3DSketch2(False)

                        swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
                        swModel.InsertCompositeCurve()

                        UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
                    Next i


                Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle

                    Dim Pts(,) As Double
                    Dim swSketch As SldWorks.Sketch
                    ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)

                    SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
                    Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))

                    For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
                        Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
                        Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
                        Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
                        Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
                    Next i

                    Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
                    SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
                    Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))

                    ' faut ordonner les points selon T...
                    Dim j As Integer
                    Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
                    For i = 0 To max - 2
                        For j = 0 To max - i - 1
                            If Pts(3, j) > Pts(3, j + 1) Then
                                T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
                                Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
                                Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
                            End If
                        Next j
                    Next i

                    Dim skSeg As SldWorks.SketchSegment
                    Dim x As Double, y As Double, z As Double
                    Dim vretval As Object
                    Dim useEdge As SldWorks.SketchSegment
                    Dim m As Integer


                    For i = 0 To UBound(Pts, 2) - 1
                        swModel.Insert3DSketch2(False)
                        ' sélectionner la edge originale
                        swEnt = SlyArete1.swArete
                        swEnt.Select4(False, Nothing)
                        swModel.SketchUseEdge2(False)
                        swSketch = swModel.GetActiveSketch2()

                        ' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
                        If i <> 0 Then ' premier pick, élimine ce qui est avant.
                            skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01)    'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
                            skSeg.ConstructionGeometry = True ' ligne de construction
                            swModel.ClearSelection2(True)
                            ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
                            SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
                            vretval = swSketch.GetSketchSegments
                            useEdge = vretval(0) : m = 0
                            Do Until useEdge.ConstructionGeometry = False
                                m += 1
                                useEdge = vretval(m)
                            Loop
                            useEdge.Select4(False, Nothing)
                            swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
                            skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
                            skSeg.ConstructionGeometry = True
                        End If

                        If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
                            skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
                            skSeg.ConstructionGeometry = True ' ligne de construction
                            swModel.ClearSelection2(True)

                            ' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
                            SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
                            vretval = swSketch.GetSketchSegments
                            useEdge = vretval(0) : m = 0
                            Do Until useEdge.ConstructionGeometry = False
                                m += 1
                                useEdge = vretval(m)
                            Loop

                            useEdge.Select4(False, Nothing)
                            swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
                            skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
                            skSeg.ConstructionGeometry = True
                        End If

                        swModel.Insert3DSketch2(False)
                        swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
                        swModel.InsertCompositeCurve()
                        UpdateAttributs(SlyArete1, i)
                    Next i

                End If

                ' tagger la vieille poutre pour ne pas la reprendre dans magic
                'Pour ça on ajoute un attribut pour ignorer...
                Dim nom As String
                Dim no As Integer
                Dim arete As SldWorks.Edge

                arete = SlyArete1.swArete
                swEnt = arete
                nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
                attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
                'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
                If attr Is Nothing Then
                    Commun.ColorerAretes()
                    swEnt = SlyArete1.swArete
                    attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
                End If

                Dim p As SldWorks.Parameter
                p = attr.GetParameter("D1")
                p.SetDoubleValue(-9)
                p = attr.GetParameter("D2")
                p.SetDoubleValue(-9)
                p = attr.GetParameter("D3")
                p.SetDoubleValue(-9)
                p = attr.GetParameter("D4")
                p.SetDoubleValue(-9)

                If attr Is Nothing Then MsgBox("Pas marché")


            End If
        Next SlyArete1


    End Sub


    Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByRef i As Integer)
        Dim newArete As SldWorks.Edge
        Dim refcurve As SldWorks.ReferenceCurve
        Dim attr As SldWorks.Attribute
        Dim swfeat As SldWorks.Feature

        swfeat = swModel.FeatureByPositionReverse(0)

        refcurve = swfeat.GetSpecificFeature2()
        newArete = refcurve.GetFirstSegment()

        Dim ParamM As SldWorks.Parameter
        Dim ParamS As SldWorks.Parameter
        Dim ParamI1 As SldWorks.Parameter
        Dim ParamI2 As SldWorks.Parameter
        Dim ParamD1 As SldWorks.Parameter
        Dim ParamD2 As SldWorks.Parameter
        Dim ParamD3 As SldWorks.Parameter
        Dim ParamD4 As SldWorks.Parameter
        Dim ParamD5 As SldWorks.Parameter
        Dim ParamD6 As SldWorks.Parameter
        Dim ParamAs As SldWorks.Parameter
        Dim ParamN3 As SldWorks.Parameter

        attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)

        ParamM = attr.GetParameter("M")
        ParamS = attr.GetParameter("S")
        ParamI1 = attr.GetParameter("I1")
        ParamI2 = attr.GetParameter("I2")
        ParamD1 = attr.GetParameter("D1")
        ParamD2 = attr.GetParameter("D2")
        ParamD3 = attr.GetParameter("D3")
        ParamD4 = attr.GetParameter("D4")
        ParamD5 = attr.GetParameter("D5")
        ParamD6 = attr.GetParameter("D6")
        ParamAs = attr.GetParameter("As")

        ParamM.SetStringValue2(slyarete1.GetM, 2, "")  ' swAllConfiguration = 2
        ParamS.SetStringValue2(slyarete1.GetSection, 2, "")
        ParamI1.SetDoubleValue2(slyarete1.GetInertieXX, 2, "")
        ParamI2.SetDoubleValue2(slyarete1.GetInertieYY, 2, "")
        ParamD1.SetDoubleValue2(slyarete1.GetD1, 2, "")
        ParamD2.SetDoubleValue2(slyarete1.GetD2, 2, "")
        ParamD3.SetDoubleValue2(slyarete1.GetD3, 2, "")
        ParamD4.SetDoubleValue2(slyarete1.GetD4, 2, "")
        ParamD5.SetDoubleValue2(slyarete1.GetD5, 2, "")
        ParamD6.SetDoubleValue2(slyarete1.GetD6, 2, "")
        ParamAs.SetDoubleValue2(slyarete1.GetAireSection, 2, "")

        Dim p As SldWorks.Parameter
        p = attr.GetParameter("N3")
        p.SetStringValue(slyarete1.GetN3)
        p = attr.GetParameter("X3")
        p.SetDoubleValue2(slyarete1.X3, 2, "")
        p = attr.GetParameter("Y3")
        p.SetDoubleValue2(slyarete1.Y3, 2, "")
        p = attr.GetParameter("Z3")
        p.SetDoubleValue2(slyarete1.Z3, 2, "")

        Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)

    End Sub


    ''' <summary>
    ''' sub qui gère la détection des intersections entre les coques et les volumes.
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DetectionCoqueVolume()

        ' détection de coque-coque
        Dim Face1 As SlyFaceVolume
        Dim coque2 As SlyFaceCoque
        Dim sketch As SldWorks.Sketch = Nothing
        Dim interFF As InterCoqueVolume

        For Each Face1 In Commun.lst_FaceVolume
            For Each coque2 In lst_FaceCoque

                If DetectFaceFace(coque2, Face1, True, sketch) Then
                    ' création de l'instance de interFace-face entre coque et coque


                    interFF = New InterCoqueVolume
                    interFF.sFaceVolume = Face1
                    interFF.sFaceCoque = coque2
                    If coque2.PossedeFaceDeSection = True Then
                        interFF.FaceDeSection = True
                        Verifier_Coque_Section(interFF)
                    Else
                        interFF.FaceDeSection = False
                    End If
                    interFF.sketch = sketch
                    coque2.lst_InterCoqueVolume.Add(interFF)
                End If

            Next
        Next


    End Sub

    ''' <summary>
    ''' Sub qui fait les 6 vérifications pour le type d'intersection où la coque est partiellement dessinée en 3D.
    ''' En profite également pour remettre à jour la proriété de l'épaisseur de la coque 
    ''' </summary>
    ''' <param name="interFF">L'intersection</param>
    ''' <remarks>On fait au total 6 vérifications</remarks>
    Private Sub Verifier_Coque_Section(ByRef interFF As InterCoqueVolume)
        Dim sFaceCoque As SlyFaceCoque
        Dim sFaceVol As SlyFaceVolume
        Dim swFace1 As SldWorks.Face2
        Dim swent As SldWorks.Entity

        sFaceCoque = interFF.sFaceCoque
        sFaceVol = interFF.sFaceVolume

        ' 1 - vérifier que la face du volume est plane
        If Not sFaceVol.estPlan Then
            Err.Raise(513, "Verifier_Coque_Section", "La face représentant la section de la coque n'est pas plane...")
        End If

        ' 1.5 - La face du volume a 4 courbes, 2 petites de même longueur et 2 longues
        ' 1.6 ou qu'elle est une courbe fermée avec 2 loop d'une seule arète chaque.
        Dim vEdges As Object
        Dim Aretes() As SldWorks.Edge
        Dim longueur(3) As Double
        Dim i As Integer
        Dim a As SldWorks.Edge
        ReDim Aretes(0)

        swFace1 = sFaceVol.SwFace

        vEdges = swFace1.GetEdges()
        For Each a In vEdges
            ReDim Preserve Aretes(i)
            Aretes(i) = a
            i += 1
        Next

        If UBound(Aretes) = 3 Then
            For i = 0 To 3
                longueur(i) = Commun.GetLongueurArete(Aretes(i))
            Next i
            longueur = Ordonner(longueur, Aretes)
            If Not Math.Abs(longueur(0) - longueur(1)) < Epsilon Then
                swent = swFace1 : swent.Select2(False, 0)
                Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 petites arètes de la même longueur, ce n'est pas normal.   La face a problème a été sélectionée")
            End If

        ElseIf UBound(Aretes) = 1 Then ' la coque représente un cylindre (ou un autre truc fermé)
            If Not swFace1.GetLoopCount = 2 Then
                swent = swFace1 : swent.Select2(False, 0)
                Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 ou 4 arêtes ou n'est pas correcte...  La face a problème a été sélectionée")
            End If
        Else
            swent = swFace1 : swent.Select2(False, 0)
            Err.Raise(514, "Verifier_Coque_Section", "La face du volume représentant la coque n'a pas 2 ou 4 arêtes.  La face a problème a été sélectionée")
        End If

        ' 2 - Vérifier que la ligne est plane, mais ça je ne sais pas comment

        ' 3 - Perpendiculaire
        ' ok, on va chercher le midpoint de la ligne et on demande la normale à cette position des 2 faces.  Puis on demande(l) 'angle entre les 2 normales...

        Dim swArete As SldWorks.Edge
        Dim vmid As Object
        Dim mid() As Double = Nothing
        Dim T As Double
        Dim u() As Double, v() As Double
        Dim angle As Double

        If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume()
        swArete = interFF.AreteCoque
        T = Commun.GetTMilieu(swArete)
        vmid = swArete.Evaluate(T)
        mid = vmid

        u = sFaceVol.GetNormale(mid(0), mid(1), mid(2))
        v = sFaceCoque.GetNormale(mid(0), mid(1), mid(2))

        angle = Outils_Math.Angle2Vecteurs(u, v)

        If Not Math.Abs(angle - Pi / 2) < (Epsilon * 10) Then
            sFaceVol.Selectionner(, False)
            sFaceCoque.Selectionner(, True)
            Err.Raise(515, "Verifier_Coque_Section", "La face de la coque n'est pas perpendiculaire à la face représentant sa section.  Les faces fautives ont été sélectionées.")
        End If

        ' 4 - vérifier que les 2 petites arètes sont coupées au milieu


        ' maintenant on update l'attribut de la coque, par chance, j'ai les coordonnées du point milieu...
        Dim epaisseur As Double
        Dim distance1 As Double, distance2 As Double
        Dim point1(2) As Double, point2(2) As Double
        Dim p As Object = Nothing, p2 As Object = Nothing

        If UBound(Aretes) = 3 Then
            p = Aretes(2).GetClosestPointOn(mid(0), mid(1), mid(2))
            point1(0) = p(0) : point1(1) = p(1) : point1(2) = p(2)
            distance1 = Math.Sqrt((point1(0) - mid(0)) ^ 2 + (point1(1) - mid(1)) ^ 2 + (point1(2) - mid(2)) ^ 2)

            p = Aretes(3).GetClosestPointOn(mid(0), mid(1), mid(2))
            point2(0) = p(0) : point2(1) = p(1) : point2(2) = p(2)
            distance2 = Math.Sqrt((point2(0) - mid(0)) ^ 2 + (point2(1) - mid(1)) ^ 2 + (point2(2) - mid(2)) ^ 2)

            If Not Math.Abs(distance1 - distance2) < Epsilon Then
                Err.Raise(516, "Verifier_Coque_Section", "La distance n'est pas la même de chaque coté de la coque")
            Else
                epaisseur = distance1 * 2
            End If

        ElseIf UBound(Aretes) = 1 Then ' on a des cercles
            epaisseur = swModel.ClosestDistance(Aretes(0), Aretes(1), p, p2)
            If epaisseur <= 0 Then MsgBox("Il y a un problème ici...")
        Else
            MsgBox("On ne doit jamias passer ici en principe")
        End If

        sFaceCoque.SetAttributDeCoque(epaisseur)

    End Sub

    ''' <summary>
    '''  sub qui découpe une face en fonction des paramètres qu'on lui passe.
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub DécouperCoqueVolume()

        Dim coque1 As SlyFaceCoque
        Dim interFF As InterCoqueVolume

        ' 1 - Pour toutes les coques

        For Each coque1 In Commun.lst_FaceCoque
            For Each interFF In coque1.lst_InterCoqueVolume
                If interFF.FaceDeSection Then
                    CoupeCoque1(interFF)
                Else
                    interFF.GénérerSweep() ' étape 4
                    interFF.DécouperVolume() ' étape 5
                    If interFF.DoitCouperCoque Then ' on découpe aussi couper la coque selon le sweep
                        interFF.DecouperCoque()
                        interFF.QuelleAreteCoqueToucheVolume(True)
                    Else
                        interFF.QuelleAreteCoqueToucheVolume(False)
                    End If
                    If interFF.DerniereCoupe Then interFF.DecouperCoque()
                    interFF.MarquerFacesInternes() ' étape 6

                End If
            Next
        Next coque1


    End Sub


    ''' <summary>
    ''' Lorsque la coque est modélisée en partie par un morceau de volume.  Dessine et coupe.
    ''' </summary>
    ''' <param name="int">L'interFaceFace</param>
    ''' <remarks></remarks>
    Private Sub CoupeCoque1(ByRef int As InterCoqueVolume)
        Dim sCoque As SlyFaceCoque
        Dim sVol As SlyFaceVolume
        Dim swFace As SldWorks.Face2
        Dim swent As SldWorks.Entity
        Dim sketch As SldWorks.Sketch
        Dim vEdges As Object
        Dim swArete As SldWorks.Edge
        Dim aretes() As SldWorks.Edge = Nothing
        Dim i As Integer

        ' a - prendre la face du volume  
        sVol = int.sFaceVolume
        swFace = sVol.SwFace
        sVol.Selectionner(0, False)

        ' b - lui mettre une esquisse
        swModel.InsertSketch2(True)

        ' c - convertir l'esquisse déjà créée
        sketch = int.sketch
        swent = sketch
        swent.Select2(False, 0)

        swModel.SketchUseEdge2(False)

        ' si la face est carrée

        If swFace.GetEdgeCount = 4 Then
            ' d - ajouter des lignes pour  compléter l'esquisse
            Dim longueur(3) As Double


            Dim vLine As Object
            Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
            Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
            Dim skSeg As SldWorks.SketchSegment
            vEdges = swFace.GetEdges()
            For Each swArete In vEdges
                ReDim Preserve aretes(i)
                aretes(i) = swArete
                i += 1
            Next
            For i = 0 To 3
                longueur(i) = Commun.GetLongueurArete(vEdges(i))
            Next i
            longueur = Ordonner(longueur, aretes)

            swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
            swModel.SketchUseEdge2(False)
            sketch = swModel.GetActiveSketch()
            vLine = sketch.GetSketchSegments()
            skSeg = vLine(0) : line1 = skSeg
            skSeg = vLine(1) : line2 = skSeg

            P1 = line1.GetStartPoint2()
            P2 = line1.GetEndPoint2()
            P3 = line2.GetStartPoint2()
            P4 = line2.GetEndPoint2()

            If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
                swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
                swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
            Else ' ligne entre 1 et 4 & 2 et 3
                swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
                swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
            End If
        Else
            sketch = swModel.GetActiveSketch()
        End If
        swModel.InsertSketch2(True)


        ' e - splitter
        swent = swFace : swent.Select2(False, 1)
        swent = sketch : swent.Select2(True, 4)
        swModel.InsertSplitLineProject(False, False)


        ' f - mettre un FaceInterne sur les 2 faces résultantes.
        Dim swFeat As SldWorks.Feature
        Dim vFace As Object
        Dim swFace1 As SldWorks.Face2, swFace2 As SldWorks.Face2
        Dim attr As SldWorks.Attribute
        Dim nom As String
        Dim no As Long
        swFeat = swModel.FeatureByPositionReverse(0)
        vFace = swFeat.GetFaces

        swFace1 = vFace(0)
        swFace2 = vFace(1)

        swent = swFace1
        attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
        nom = "FaceInterneCoque1"
        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig

        While attr Is Nothing
            no += 1
            nom = "FaceInterneCoque" & CStr(no)
            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
        End While
        GererDossiers("FaceInternes", nom)

        swent = swFace2
        attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
        nom = "FaceInterneCoque1"
        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig

        While attr Is Nothing
            no += 1
            nom = "FaceInterneCoque" & CStr(no)
            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
        End While
        GererDossiers("FaceInternes", nom)


    End Sub


    ''' <summary>
    ''' Détecte s'il y a une intersection entre une coque et une face d'un volume
    ''' </summary>
    ''' <param name="sFaceCoque"></param>
    ''' <param name="sFaceVolume"></param>
    ''' <param name="dessiner">Si oui, alors on dessine une ligne à l'intersection</param>
    ''' <param name="sketch">Si dessiner est vrai, alors ce sketch contient la ligne d'intersection</param>
    ''' <returns>Vrai s'il y a une intersection</returns>
    ''' <remarks></remarks>
    Private Function DetectFaceFace(ByRef sFaceCoque As SlyFaceCoque, ByRef sFaceVolume As SlyFaceVolume, Optional ByRef dessiner As Boolean = False, Optional ByRef sketch As SldWorks.Sketch = Nothing) As Boolean
        For Each swfc As SldWorks.Face2 In sFaceCoque.lst_Faces
            For Each swFV As SldWorks.Face2 In sFaceVolume.lst_Faces
                If DetectFaceFace(swfc, swFV, dessiner, sketch) Then Return True
            Next
        Next
    End Function


    ''' <summary>
    ''' Function qui retourne vrai ou faux si 2 FACES (pas surfaces) se touchent.  La routine finit par appeler la sub dessinecourbe pour dessiner la courbe.
    ''' </summary>
    ''' <param name="face1">Première face</param>
    ''' <param name="face2">Seconde face</param>
    ''' <param name="dessiner">Si l'on veut dessiner une esquisse contenant la courbe</param>
    ''' <param name="Sketch">Si la première option est vrai, ce paramètre redonne l'esquisse qui contient la courbe</param>
    ''' <returns>Vrai si les faces se touchent</returns>
    ''' <remarks>Si les 2 faces se touchent en un seul point alors ça retourne faux.</remarks>
    Private Function DetectFaceFace(ByRef face1 As SldWorks.Face2, ByRef face2 As SldWorks.Face2, Optional ByRef dessiner As Boolean = False, Optional ByRef Sketch As SldWorks.Sketch = Nothing) As Boolean
        ' sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
        Dim Surface1 As SldWorks.Surface
        Dim Surface2 As SldWorks.Surface
        Dim curveArray As Object = Nothing
        Dim curve As SldWorks.Curve
        Dim ret As Boolean
        Dim boundsArray As Object = Nothing
        Dim bounds() As Double
        Dim Point1(2) As Double
        Dim Point2(2) As Double
        Dim P1 As Object = Nothing, P2 As Object = Nothing
        Dim ClosestDist As Double

        Surface1 = face1.GetSurface
        Surface2 = face2.GetSurface

        ClosestDist = swModel.ClosestDistance(face1, face2, P1, P2)
        If ClosestDist > (Epsilon * 10) Then Return False

        ' curvearray est un tableau de curves, boundsarray est un tableau de T des limites de la courbe
        ret = Surface1.IntersectSurface(Surface2, curveArray, boundsArray) ' si c'est une ligne, retourne une ligne infinie...
        ' il faut alors renvoyer vers le detectFaceArete()
        If Not ret Then Return False
        bounds = boundsArray

        'On Error GoTo faceSurFace
        Try
            curve = curveArray(0)
        Catch
            Debug.Write("On a une intersection où 2 faces sont sur la même surface...")
            Return False ' ouch... pas certain.
        End Try


        If Not curve.IsLine Then ' si c'est une ligne, alors le principe de longueur ne fonctionnera pas...
            Dim longueur As Double = curve.GetLength2(bounds(0), bounds(1))
            If longueur < Epsilon Then Return False ' on a juste un point d'intersection
        Else
            Dim vParam As Object
            vParam = curve.GetClosestPointOn(P1(0), P1(1), P1(2))  ' vparam(3) est le U

            P1 = curve.Evaluate(vParam(3) + 100 * Epsilon) : Point1 = P1
            P2 = curve.Evaluate(vParam(3) - 100 * Epsilon) : Point2 = P2

            If (Distance(face1, Point1(0), Point1(1), Point1(2)) < Epsilon) And (Distance(face2, Point1(0), Point1(1), Point1(2)) < Epsilon) Then
            ElseIf (Distance(face1, Point2(0), Point2(1), Point2(2)) < Epsilon) And (Distance(face2, Point2(0), Point2(1), Point2(2)) < Epsilon) Then
            Else
                Return False
            End If
        End If


        If dessiner Then
            Dim swent As SldWorks.Entity
            Dim feat As SldWorks.Feature
            swModel.Insert3DSketch2(False)

            swent = face1 : swent.Select2(False, 0)
            swent = face2 : swent.Select2(True, 0)
            swModel.Sketch3DIntersections()

            swModel.Insert3DSketch2(False)
            swModel.EditRebuild3()
            feat = swModel.FeatureByPositionReverse(0)

            Sketch = feat.GetSpecificFeature2
        End If

        Return True
        'If curve.IsTrimmedCurve = False And curve.IsLine Then    ' si c'est une ligne, alors l'enfoirée est de longueur infinie. courbe spline... pas de problèmes.

        '    Dim vEdge As Object, swAreteTest As SldWorks.Edge, xyz() As Double = Nothing, n As Integer
        '    Dim lst_T() As Double = Nothing, final() As Double
        '    Dim NewCourbe As SldWorks.Curve

        '    For n = 1 To 2
        '        If n = 1 Then vEdge = face1.GetEdges() Else vEdge = face2.GetEdges()
        '        For f = 0 To UBound(vEdge)
        '            swAreteTest = vEdge(f)
        '            If DetectAreteArete(swAreteTest, curve, xyz) Then

        '                If Not UBound(xyz) > 4 Then
        '                    vT = curve.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
        '                    T = vT(3)

        '                    If lst_T Is Nothing Then ReDim lst_T(0) Else ReDim Preserve lst_T(UBound(lst_T) + 1)
        '                    lst_T(UBound(lst_T)) = T
        '                End If
        '            End If
        '        Next f
        '    Next n

        '    final = trier(lst_T)

        '    For i = 0 To UBound(final) Step 2
        '        Dim skseg As SldWorks.SketchSegment, angle As Double

        '        Point1 = curve.Evaluate(final(i)) : Point2 = curve.Evaluate(final(i + 1))
        '        NewCourbe = curve.CreateTrimmedCurve2(Point1(0), Point1(1), Point1(2), Point2(0), Point2(1), Point2(2))
        '        If dessiner Then skseg = Commun.DessineCourbe(NewCourbe) : Sketch = skseg.GetSketch
        '        angle = AngleEntre2Faces(face1, face2, Point1) / 0.0174532925

        '        'swApp.SendMsgToUser(" Courbe Droite " & angle)
        '    Next

        'ElseIf curve.IsTrimmedCurve = False Then  ' courbe périodique... donc pas trimmée mais avec des bounds...
        '    If dessiner Then
        '        Commun.DessineCourbe(curve)
        '        Sketch = swModel.FeatureByPositionReverse(0)
        '    End If


        'Else
        '    If dessiner Then
        '        Commun.DessineCourbe(curve)
        '        Sketch = swModel.FeatureByPositionReverse(0)
        '    End If
        'End If

        'Return True
faceSurFace:  ' les 2 surfaces sont une sur l'autre...
        'Dim swent As SldWorks.Entity
        'Dim swent2 As SldWorks.Entity
        'swent = face1 : swent.Select2(False, 0)
        'swent2 = face2 : swent2.Select2(True, 0)
        'MsgBox("2 Faces avec une surface commune...")
        'Return True
    End Function


    Public Function trier(ByRef lst() As Double) As Double()
        ' sub qui retourne les T min et T max en fonction de la collection.
        ' normalement on enlève les 2 points max et min et il devrait nous rester un nombre pair de valeurs.
        Dim i As Integer, j As Integer
        Dim lst2() As Double

        Dim temp As Double

        If UBound(lst) < 1 Then Return Nothing

        For j = 0 To UBound(lst) - 1
            For i = 0 To UBound(lst) - j - 1
                If lst(i) > lst(i + 1) Then
                    temp = lst(i)
                    lst(i) = lst(i + 1)
                    lst(i + 1) = temp
                End If
            Next i
        Next j

        ReDim lst2(UBound(lst) - 2)
        For i = 1 To UBound(lst) - 1
            lst2(i - 1) = lst(i)
        Next
        Return lst2


    End Function

    ''' <summary>
    ''' Function qui remet en ordre croissant les valeurs d'un tableau
    ''' </summary>
    ''' <param name="lst">Le tableau de valeurs à ordonner</param>
    ''' <param name="liste2">un second tableau que l'on peut ordonner</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Ordonner(ByRef lst() As Double, Optional ByRef liste2() As SldWorks.Edge = Nothing) As Double()

        Dim i As Integer, j As Integer
        Dim temp2 As Object

        Dim temp As Double

        If UBound(lst) < 1 Then Return Nothing

        For j = 0 To UBound(lst) - 1
            For i = 0 To UBound(lst) - j - 1
                If lst(i) > lst(i + 1) Then
                    temp = lst(i)
                    lst(i) = lst(i + 1)
                    lst(i + 1) = temp
                    If Not liste2 Is Nothing Then
                        temp2 = liste2(i)
                        liste2(i) = liste2(i + 1)
                        liste2(i + 1) = temp2
                    End If

                End If
            Next i
        Next j

        Return lst


    End Function


End Module
Revision:	48
Committed:	Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size:	96320 byte(s)
Log Message:	On passe aux nouveaux .dll