REPOS_ERICCA/magicsld/Commun.vb

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

Module Commun

    Public Const Pi As Double = 3.1415926535897931
    Public Epsilon As Double = 0.000000001 'à changer en fonction du type d'unité utilisé

    Public Imax As Double = 1 ' valeur maximale de l'inertie.
    Public Amax As Double = 1000 ' et de l'aire

    Public NBAreteDoublon As Integer  ' sais pas où d'autre ne peut mémoriser ce nombre...

    Public swApp As SldWorks.SldWorks
    Public swPart As SldWorks.PartDoc
    Public swModel As SldWorks.ModelDoc2

    Public lst_AreteVolume As New Collections.ObjectModel.Collection(Of SlyAreteVol) ' liste de courbes appartenant au volume
    Public lst_AreteCoque As New Collections.ObjectModel.Collection(Of SlyAreteCoque) ' liste de courbes appartenant aux coques
    Public lst_AretePoutre As New Collections.ObjectModel.Collection(Of SlyAretePoutre) ' liste de courbe libres
    Public lst_FaceVolume As New Collections.Generic.List(Of SlyFaceVolume)    ' liste de faces appartenant au volume
    Public lst_FaceCoque As New Collections.ObjectModel.Collection(Of SlyFaceCoque) ' liste de face libres
    Public lst_SommetVolume As New Collections.ObjectModel.Collection(Of SlySommetVolume)
    Public lst_SommetCoque As New Collections.ObjectModel.Collection(Of SlySommetCoque)
    Public lst_sommetPoutre As New Collections.ObjectModel.Collection(Of SlySommetPoutre)

    Public ENG As Double
    Private NameFichierPog As String

    Public lst_AreteDoublon As New Collection

    Public OptionMettreNoteIntersection As Boolean = False


    Public Structure sectionPoutre
        Dim nom As String
        Dim I1 As Double
        Dim I2 As Double
        Dim D1 As Double
        Dim D2 As Double
        Dim D3 As Double
        Dim D4 As Double
        Dim D5 As Double
        Dim D6 As Double
        Dim Aire As Double
    End Structure


    Public Enum tipe_e
        Volume = 0
        coque = 1
        poutre = 2
        MiniPoutre = 3
    End Enum

    ''' <summary>
    ''' L'écart nodal Global (ENG).
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks>Doit être mémorisé ici pour pouvoir l'utiliser partout...</remarks>
    Public Property ÉcartNodal() As Double
        Get
            Return ENG
        End Get
        Set(ByVal value As Double)
            ENG = value
        End Set
    End Property

    Public Property NomFichierPog() As String
        Get
            Return NameFichierPog
        End Get
        Set(ByVal value As String)
            NameFichierPog = value
        End Set
    End Property


    Public Sub GenererListes(Optional ByVal ChercheAttribut As Boolean = True)
        ' sub qui créé les entités Sly... et le met dans les listes

        Dim vBodies As Object
        Dim swBody As SldWorks.Body2
        Dim v As Integer
        Dim swFace As SldWorks.Face2
        Dim swLoop As SldWorks.Loop2
        Dim swCoArete As SldWorks.CoEdge
        Dim swArete As SldWorks.Edge
        Dim swSommet1 As SldWorks.Vertex
        Dim swSommet2 As SldWorks.Vertex
        'Dim nouveau As Boolean ' bit qui dit si on est entrain d'updater (false) ou si on recommence du début (true)

        ' on doit commencer par vider les listes, sinon on peut travailler sur les listes d'un autre fichier...
        ' ne vérifie plus si on update ou si on recommence, ce n'est plus nécessaire.
        Intersections.RegisterAttribut()

        videliste()
        Call SuperFace.reinitialiser() ' remet les compteurs à 0
        Call SuperArete.reinitialiser()
        Call SuperSommet.reinitialiser()

        vBodies = swPart.GetBodies2(swconst.swBodyType_e.swSolidBody, True)
        If Not vBodies Is Nothing Then
            For v = 0 To UBound(vBodies)
                swBody = vBodies(v)
                swFace = swBody.GetFirstFace

                Do While Not swFace Is Nothing
                    If trouver(swFace, tipe_e.Volume) Is Nothing Then
                        Dim slyface As New SlyFaceVolume(swFace)
                        lst_FaceVolume.Add(slyface)
                    End If


                    swLoop = swFace.GetFirstLoop
                    Do While Not swLoop Is Nothing

                        swCoArete = swLoop.GetFirstCoEdge
                        Dim coa As Integer
                        For coa = 0 To swLoop.GetEdgeCount - 1

                            swArete = swCoArete.GetEdge
                            If (Not Ignorer(swArete)) Then
                                If trouver(swArete, tipe_e.Volume, True) Is Nothing Then
                                    Dim slyArete As New SlyAreteVol(swArete)
                                    lst_AreteVolume.Add(slyArete)
                                End If

                                swSommet1 = swArete.GetStartVertex
                                If IsNothing(swSommet1) Then
                                    'MsgBox("On a une courbe sans sommet")
                                Else
                                    If (trouver(swSommet1, tipe_e.Volume) Is Nothing) Then
                                        Dim slySommet As New SlySommetVolume(swSommet1)
                                        lst_SommetVolume.Add(slySommet)
                                    End If

                                    swSommet2 = swArete.GetEndVertex
                                    If (trouver(swSommet2, tipe_e.Volume) Is Nothing) Then
                                        Dim slySommet As New SlySommetVolume(swSommet2)
                                        lst_SommetVolume.Add(slySommet)
                                    End If
                                End If

                                swCoArete = swCoArete.GetNext
                            End If
                        Next coa ' fin de loop sur les coaretes

                        swLoop = swLoop.GetNext
                    Loop ' fin loop sur loop

                    swFace = swFace.GetNextFace()
                Loop ' fin loop sur faces
            Next v ' next volume
        End If  ' s'il y a un corps (ou plus) on entre dans la boucle, sinon on continue sur les coques et poutres


        ' on fait le tour des features pour avoir les poutres et les coques
        Dim feat As SldWorks.Feature
        Dim vSupprime As Object
        Dim bSupprime As Boolean
        Dim ent As SldWorks.Entity
        Dim attr As SldWorks.Attribute


        feat = swPart.FirstFeature

        Do While Not feat Is Nothing

            vSupprime = feat.IsSuppressed
            bSupprime = CBool(vSupprime)
            If Not bSupprime Then  ' on vérifie que l'entité est pas supprimée
                Try
                    Select Case feat.GetTypeName
                        Case "CompositeCurve", "3DSplineCurve" ', "Helix"  'le feature est une courbe libre

                            Dim refCourbe As sldworks.ReferenceCurve

                            refCourbe = feat.GetSpecificFeature2
                            swArete = refCourbe.GetFirstSegment
                            Do While Not swArete Is Nothing

                                If (Not Ignorer(swArete)) Then
                                    Dim slyArete As SlyAretePoutre
                                    slyArete = trouver(swArete, tipe_e.poutre)

                                    If slyArete Is Nothing Then
                                        slyArete = New SlyAretePoutre(swArete)
                                        lst_AretePoutre.Add(slyArete)
                                    End If

                                    swSommet1 = swArete.GetStartVertex
                                    If IsNothing(swSommet1) Then
                                        'MsgBox("On a une courbe sans sommet")
                                    Else
                                        If trouver(swSommet1, tipe_e.poutre) Is Nothing Then
                                            Dim slySommet As New SlySommetPoutre(swSommet1)
                                            lst_sommetPoutre.Add(slySommet)
                                        End If

                                        swSommet2 = swArete.GetEndVertex
                                        If trouver(swSommet2, tipe_e.poutre) Is Nothing Then
                                            Dim slySommet As New SlySommetPoutre(swSommet2)
                                            lst_sommetPoutre.Add(slySommet)
                                        End If
                                    End If

                                    ' on cherche s'il n'y aurait pas un attribut sur la poutre
                                    'If ChercheAttribut Then
                                    Try
                                        ent = swArete
                                        attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
                                        slyArete.swAttribute = attr
                                        If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
                                        'Dim xyz() As Double
                                        'xyz = slyarete.GetPoint3
                                        'slyarete.X3 = xyz(0)
                                        'slyarete.y3 = xyz(1)
                                        'slyarete.z3 = xyz(2)
                                    Catch ex As Exception
                                        MsgBox("Une poutre sans attributs est détectée dans le modèle!")
                                    End Try

                                End If

                                swArete = Nothing
                                swArete = refCourbe.GetNextSegment

                            Loop


                        Case "PLine", "ExtruRefSurface", "RevolvRefSurf", "SweepRefSurface", "BlendRefSurface", "OffsetRefSurface", "ExtendRefSurface", "PlanarSurface", "RadiateRefSurface", "MidRefSurface", "FillRefSurface", "RefSurface"

                            ' le feature est une surface libre, certains types de surface n'ont pas été gardés car
                            ' leur face appartient à un autre feature ou parce qu'il sont impossible à retrouver dans un multimodèle


                            ' Attention, si c'est une PLine ça peut prendre un volume

                            Dim body As sldworks.Body2
                            Dim vFaces As Object
                            Dim vf As Object
                            Dim slyFace As SlyFaceCoque
                            Dim ShellBody As sldworks.Body2

                            vFaces = feat.GetFaces
                            If Not vFaces Is Nothing Then
                                For Each vf In vFaces
                                    swFace = vf
                                    ShellBody = swFace.GetBody : If ShellBody.Visible = False Then Continue For
                                    body = swFace.GetBody


                                    If Not (body.GetType = swconst.swBodyType_e.swSolidBody) Then  ' si le body est quelquechose de solide alors on a le feature Pline d'un solide....

                                        slyFace = trouver(swFace, tipe_e.coque)
                                        If slyFace Is Nothing Then

                                            slyFace = New SlyFaceCoque(swFace)
                                            lst_FaceCoque.Add(slyFace)
                                        End If


                                        ' ***** détection des attributs des coques
                                        attr = Nothing
                                        If ChercheAttribut Then
                                            Try
                                                ent = swFace
                                                attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
                                                slyFace.swAttribute = attr
                                            Catch ex As Exception
                                                MsgBox("Une coque sans attributs est détectée dans le modèle!")
                                            End Try

                                            If IsNothing(attr) Then  ' on a trouvé un attribut de coque
                                                'il n'y a pas encore d'attributs sur cette coque.
                                                'MsgBox("Le putain d'attribut n'a pas été détecté!")
                                            End If
                                        End If

                                        swLoop = swFace.GetFirstLoop
                                        Do While Not swLoop Is Nothing
                                            swCoArete = swLoop.GetFirstCoEdge
                                            Dim coa As Integer
                                            For coa = 0 To swLoop.GetEdgeCount - 1

                                                swArete = swCoArete.GetEdge

                                                If (Not Ignorer(swArete)) Then
                                                    If trouver(swArete, tipe_e.coque) Is Nothing Then
                                                        Dim slyArete As New SlyAreteCoque(swArete)
                                                        lst_AreteCoque.Add(slyArete)
                                                    End If

                                                    swSommet1 = swArete.GetStartVertex
                                                    If IsNothing(swSommet1) Then
                                                        'MsgBox("On a une courbe sans sommet")
                                                    Else
                                                        If trouver(swSommet1, tipe_e.coque) Is Nothing Then
                                                            Dim slySommet As New SlySommetCoque(swSommet1)
                                                            lst_SommetCoque.Add(slySommet)
                                                        End If

                                                        swSommet2 = swArete.GetEndVertex
                                                        If trouver(swSommet2, tipe_e.coque) Is Nothing Then
                                                            Dim slySommet As New SlySommetCoque(swSommet2)
                                                            lst_SommetCoque.Add(slySommet)
                                                        End If
                                                    End If

                                                    swCoArete = swCoArete.GetNext
                                                End If
                                            Next coa ' fin de loop sur les coaretes

                                            swLoop = swLoop.GetNext
                                        Loop ' fin loop sur loop
                                    Else
                                        'MsgBox("On vient de retirer une PLine appartenant à un volume!", MsgBoxStyle.Exclamation)
                                    End If
                                Next vf
                            End If

                        Case Else ' n'est pas un feature intéressant...
                            ' rien
                    End Select
                Catch
                    MsgBox("Générer liste n'a pas marché sur le feature: " & feat.Name)
                End Try

            End If ' fin du if sur la suppression du feature
            feat = feat.GetNextFeature
        Loop

    End Sub

    Public Sub MettreNoms()
        ' place les noms des SlyClasses sur les entités puis sauvegarde

        'Debug.Write("  Title        = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoTitle))
        'Debug.Write("  Subject      = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSubject))
        'Debug.Write("  Author       = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoAuthor))
        'Debug.Write("  Keywords     = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoKeywords))
        'Debug.Write("  Comment      = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoComment))
        'Debug.Write("  SavedBy      = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSavedBy))
        'Debug.Write("  CreateDate   = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoCreateDate))
        'Debug.Write("  SaveDate     = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSaveDate))
        'Debug.Write("  CreateDate2  = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoCreateDate2))
        'Debug.Write("  SaveDate2    = " + swModel.SummaryInfo(SwConst.swSummInfoField_e.swSumInfoSaveDate2))
        Static saveModel As SldWorks.ModelDoc2
        Static passe As Boolean = False

        If (swModel Is saveModel) And (passe = True) Then
            Exit Sub  ' faudrait pas passer 2 fois dans le mettrenoms...
        Else
            saveModel = swModel
        End If
        passe = True


        'VideNom() ' on commence par enlever les noms (on suppose qu'il n'y en a pas déjà...)

        Dim s1 As SlyAreteVol
        For Each s1 In lst_AreteVolume
            s1.SaveNom()
        Next

        Dim s2 As SlyAreteCoque
        For Each s2 In lst_AreteCoque
            s2.SaveNom()
        Next

        Dim s3 As SlyAretePoutre
        For Each s3 In lst_AretePoutre
            s3.SaveNom()
        Next

        Dim s4 As SlyFaceVolume
        For Each s4 In lst_FaceVolume
            s4.SaveNom()
        Next

        Dim s5 As SlyFaceCoque
        For Each s5 In lst_FaceCoque
            s5.SaveNom()
        Next

        Dim s6 As SlySommetVolume
        For Each s6 In lst_SommetVolume
            s6.SaveNom()
        Next

        Dim s7 As SlySommetCoque
        For Each s7 In lst_SommetCoque
            s7.SaveNom()
        Next

        Dim s8 As SlySommetPoutre
        For Each s8 In lst_sommetPoutre
            s8.SaveNom()
        Next

    End Sub

    Public Sub videliste(Of T)(ByRef liste As Collections.Generic.List(Of T))
        liste.Clear()
    End Sub


    Public Sub videliste()
        lst_AreteVolume.Clear()
        lst_AreteCoque.Clear()
        lst_AretePoutre.Clear()
        lst_FaceVolume.Clear()
        lst_FaceCoque.Clear()
        lst_SommetVolume.Clear()
        lst_SommetCoque.Clear()
        lst_SommetCoque.Clear()
        lst_sommetPoutre.Clear()

    End Sub

    Public Overloads Function getNom(ByRef swEnt As sldworks.Entity) As String
        getNom = swPart.GetEntityName(swEnt)
    End Function

    Public Overloads Function getNom(ByRef swFace As sldworks.Face2) As String
        Dim swEnt As sldworks.Entity
        swEnt = swFace
        getNom = swPart.GetEntityName(swEnt)
    End Function

    Public Overloads Function getNom(ByRef swArete As sldworks.Edge) As String
        Dim swEnt As sldworks.Entity
        swEnt = swArete
        getNom = swPart.GetEntityName(swEnt)
    End Function

    Public Overloads Function getNom(ByRef swSommet As sldworks.Vertex) As String
        Dim swEnt As sldworks.Entity
        swEnt = swSommet
        getNom = swPart.GetEntityName(swEnt)
    End Function

    Public Sub GererDossiers(ByRef nomDossier As String, ByRef NomFeature As String)
        ' déplace un feature dans un dossier ( et créé le dossier si ce n'est pas déjà fait)

        Static copienom As String
        Dim swFeat As SldWorks.Feature
        Dim ok As Boolean
        Dim j As Integer

        If Not StrComp(nomDossier, copienom) Then
            ' on commence par vérifier qu'il n'est pas déjà créé

            swFeat = swModel.FirstFeature

            Do While Not swFeat Is Nothing
                If swFeat.GetTypeName = "FtrFolder" And swFeat.Name = nomDossier Then GoTo suite
                swFeat = swFeat.GetNextFeature
            Loop

            'on mémorise tout ce qui est sélectionné
            Dim lst_selection As New Collection
            Dim selMgr As sldworks.SelectionMgr
            selMgr = swModel.SelectionManager

            For j = 1 To selMgr.GetSelectedObjectCount
                lst_selection.Add(selMgr.GetSelectedObject5(j))
            Next j
            swModel.ClearSelection2(True)


            Dim folder As SldWorks.Feature
            Dim featMgr As SldWorks.FeatureManager
            featMgr = swModel.FeatureManager
            swModel.ClearSelection2(True)

            ' on doit mettre le folder à la fin sinon le feature risque d'être avant un parent
            j = 0
            swFeat = swModel.FeatureByPositionReverse(0)
            While Not ok
                j = j + 1
                If swFeat.GetTypeName = "ProfileFeature" Or swFeat.GetTypeName = "3DProfileFeature" Then swFeat = swModel.FeatureByPositionReverse(j) Else ok = True
            End While

            swFeat.Select(False)
            folder = featMgr.InsertFeatureTreeFolder2(1)
            If Not folder Is Nothing Then folder.Name = nomDossier
            folder = Nothing
            swPart.ReorderFeature(nomDossier, swFeat.Name)

            folder = Nothing

            ' on resélectionne les objets
            swModel.ClearSelection2(True)
            For j = 1 To lst_selection.Count
                lst_selection.Item(j).select(True)
            Next j

            swPart.ReorderFeature(NomFeature, nomDossier)
        End If

        '1 - le dossier est créé ou a déjà été créé.
        '2 - on redéplace le dossier à la fin.
suite:
        swFeat = swModel.FeatureByPositionReverse(0)
        swFeat.Select(False)
        j = 0
        While Not ok
            j = j + 1
            If swFeat.GetTypeName = "ProfileFeature" Or swFeat.GetTypeName = "3DProfileFeature" Then swFeat = swModel.FeatureByPositionReverse(j) Else ok = True
        End While
        swPart.ReorderFeature(nomDossier, swFeat.Name)
        ' 3- on déplace le feature dans le dossier

        swPart.ReorderFeature(NomFeature, nomDossier)
        'swModel.EditRebuild3()


    End Sub

    Public Overloads Function trouver(ByRef swface As sldworks.Face2, ByRef tipe As Commun.tipe_e) As Object
        Dim face As sldworks.Face2

        Select Case tipe
            Case tipe_e.Volume
                Dim sface As SlyFaceVolume
                For Each sface In lst_FaceVolume
                    'If swface Is sface.swFace Then trouver = sface : Exit Function

                    For Each face In sface.lst_Faces
                        If face Is swface Then Return sface
                    Next

                Next sface

            Case tipe_e.coque
                Dim sface As SlyFaceCoque
                For Each sface In lst_FaceCoque
                    'If swface Is sface.swFace Then trouver = sface : Exit Function
                    For Each face In sface.lst_Faces
                        If face Is swface Then Return sface
                    Next
                Next sface
        End Select
        Return Nothing ' devrait pas passer par ici...
    End Function

    Public Overloads Function trouver(ByRef swEnt As sldworks.Entity) As Object
        Dim face As sldworks.Face2
        Select Case swEnt.GetType()
            Case swconst.swSelectType_e.swSelFACES
                Dim swface As sldworks.Face2
                Dim f As SlyFaceVolume
                swface = swEnt
                For Each f In lst_FaceVolume
                    'If f.SwFace Is swface Then Return f
                    For Each face In f.lst_Faces
                        If face Is swface Then Return f
                    Next
                Next
                Dim f2 As SlyFaceCoque
                For Each f2 In lst_FaceCoque
                    'If f2.swFace Is swface Then Return f2
                    For Each face In f2.lst_Faces
                        If face Is swface Then Return f2
                    Next
                Next


            Case swconst.swSelectType_e.swSelEDGES
                Dim swArete As sldworks.Edge
                swArete = swEnt
                Dim test As Object
                test = Commun.trouver(swArete, tipe_e.Volume)
                If Not test Is Nothing Then Return test
                test = Commun.trouver(swArete, tipe_e.coque)
                If Not test Is Nothing Then Return test
                test = Commun.trouver(swArete, tipe_e.poutre)
                If Not test Is Nothing Then Return test


            Case swconst.swSelectType_e.swSelVERTICES
                Dim swSommet As sldworks.Vertex
                swSommet = swEnt

                Dim s1 As SlySommetVolume
                For Each s1 In lst_SommetVolume
                    If s1.swSommet Is swSommet Then Return s1
                Next

                Dim s2 As SlySommetCoque
                For Each s2 In lst_SommetCoque
                    If s2.swSommet Is swSommet Then Return s2
                Next

                Dim s3 As SlySommetPoutre
                For Each s3 In lst_sommetPoutre
                    If s3.swSommet Is swSommet Then Return s3
                Next

        End Select

        MsgBox("Entité non trouvée, dans commun.trouver")
        Return Nothing
    End Function

    ''' <summary>
    ''' Function qui trouve et retourne le pointeur d'une SlyArete arète si elle existe déjà
    ''' </summary>
    ''' <param name="swArete">L'arète à retrouver</param>
    ''' <param name="tipe">De quel type d'arrète il sagit</param>
    ''' <param name="Genlist">Une option pour accélérer le calcul dans certaines circonstances</param>
    ''' <returns>Le pointeur sur l'entité ou Nothing si elle est pas trouvée</returns>
    ''' <remarks></remarks>
    Public Overloads Function trouver(ByRef swArete As sldworks.Edge, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object

        Select Case tipe
            Case tipe_e.Volume
                Dim s As SlyAreteVol
                For Each s In lst_AreteVolume
                    If swArete Is s.swArete Then Return s
                Next s

                ' ok, si on est ici c'est que l'on a pas trouvé l'arètequi nous intéresse, le pointeur a changé un peu...
                If Not Genlist Then
                    Dim Testarete As New SuperArete(swArete, True)
                    For Each s In lst_AreteVolume
                        If Testarete.comparer(s.swArete) Then Return s
                    Next s
                End If

            Case tipe_e.coque
                Dim sArete As SlyAreteCoque
                For Each sArete In lst_AreteCoque
                    If swArete Is sArete.swArete Then trouver = sArete : Exit Function
                Next sArete

            Case tipe_e.poutre
                For Each sa As SlyAretePoutre In lst_AretePoutre
                    If sa.swArete Is swArete Then Return sa
                Next


            Case tipe_e.MiniPoutre
                MsgBox("Erreur, on ne devrait plus passer par ici!")
                'Dim sArete As SlyAretePoutre
                'Dim i As Integer
                'For i = 1 To lst_MiniPoutre.Count
                '    sArete = lst_MiniPoutre.Item(i)
                '    If swArete Is sArete.swArete Then trouver = sArete : Exit Function
                'Next i
        End Select
        Return Nothing
    End Function

    Public Overloads Function trouver(ByRef Arete As SuperArete, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object

        Select Case tipe
            Case tipe_e.Volume
                ' ok, si on est ici c'est que l'on a pas trouvé l'arètequi nous intéresse, le pointeur a changé un peu...
                If Not Genlist Then
                    Dim s As SlyAreteVol
                    For Each s In lst_AreteVolume
                        If Arete.comparer(s.swArete) Then Return s
                    Next s
                End If

            Case tipe_e.coque
                Dim s As SlyAreteCoque
                For Each s In lst_AreteCoque
                    If Arete.comparer(s.swArete) Then Return s
                Next s
        End Select

        Return Nothing
    End Function

    Public Overloads Function trouver(ByRef swSommet As sldworks.Vertex, ByRef tipe As Commun.tipe_e) As Object

        Select Case tipe
            Case tipe_e.Volume
                Dim sSommet As SlySommetVolume
                For Each sSommet In lst_SommetVolume
                    If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
                Next sSommet

            Case tipe_e.coque
                Dim sSommet As SlySommetCoque
                For Each sSommet In lst_SommetCoque
                    If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
                Next sSommet

            Case tipe_e.poutre
                Dim sSommet As SlySommetPoutre
                For Each sSommet In lst_sommetPoutre
                    If swSommet Is sSommet.swSommet Then trouver = sSommet : Exit Function
                Next sSommet

        End Select
        Return Nothing
    End Function

    Public Sub VideNom()
        ' procédure qui retire le nom écrit sur les entités de solidworks

        Dim vNamedEntity As Object = Nothing
        Dim swEnt As SldWorks.Entity
        Dim retval As Boolean
        Dim i As Integer

        'If MsgBox("Essayer de vider les noms?", MsgBoxStyle.YesNo) = MsgBoxResult.No Then Exit Sub

        Try
            'MsgBox(swPart.MaterialIdName)
            vNamedEntity = swPart.GetNamedEntities
        Catch
            Dim nb As String
            Try
                nb = CStr(swPart.GetNamedEntitiesCount())
            Catch
                nb = "??"
            End Try

            MsgBox("Impossibilité d'obtenir la liste des entités déjà nomées.  On continue pareil..." & vbCr & "Il y a " & "??" & " entités qui ont un nom", MsgBoxStyle.Exclamation, "Sérieux problème!")
        End Try


        If IsNothing(vNamedEntity) Then Exit Sub
        For i = 0 To UBound(vNamedEntity)
            swEnt = vNamedEntity(i)
            Debug.Write(swPart.GetEntityName(swEnt))
            retval = swPart.DeleteEntityName(swEnt)
            If retval = False Then Debug.Write("Incapable d'effacer l'entité: " & swPart.GetEntityName(swEnt)) ' MsgBox(" Incapable d'effacer l'entité: " & swPart.GetEntityName(swEnt), vbCritical, "Problème dans VideNom()")
        Next i
    End Sub

    'function qui transfert les coordonnées du modèle en coodronnées pour le sketch
    Public Function TransfertModelSketch(ByRef sketch As SldWorks.Sketch, ByRef p() As Double) As Double()
        Dim MathUtil As SldWorks.MathUtility
        Dim MathP As SldWorks.MathPoint
        Dim MathTrans As SldWorks.MathTransform
        Dim p2() As Double
        MathUtil = swApp.GetMathUtility
        MathP = MathUtil.CreatePoint(p)

        MathTrans = sketch.ModelToSketchTransform
        MathP = MathP.MultiplyTransform(MathTrans)
        p2 = MathP.ArrayData
        Return p2
    End Function


    Public Function TransfertSketchToModel(ByRef sketch As SldWorks.Sketch, ByRef p() As Double) As Double()
        Dim MathUtil As SldWorks.MathUtility
        Dim MathP As SldWorks.MathPoint
        Dim MathTrans As SldWorks.MathTransform
        Dim p2() As Double
        Dim point(2) As Double
        Dim vPoint As Object
        MathUtil = swApp.GetMathUtility
        point(0) = p(0)
        point(1) = p(1)
        If UBound(p) = 1 Then point(2) = 0 Else point(2) = p(2)
        vPoint = point
        MathP = MathUtil.CreatePoint(vPoint)

        MathTrans = sketch.ModelToSketchTransform
        MathTrans = MathTrans.Inverse
        MathP = MathP.MultiplyTransform(MathTrans)
        vPoint = MathP.ArrayData
        p2 = vPoint
        Return p2
    End Function


    Public Function DistanceMin(ByRef sCoque As SlyFaceCoque, ByRef sVolume As SlyFaceVolume) As Double
        Dim swFC As SldWorks.Face2
        Dim swFV As SldWorks.Face2
        Dim min As Double = 99999999999999
        Dim temp As Double

        For Each swFC In sCoque.lst_Faces
            For Each swFV In sVolume.lst_Faces
                temp = swModel.ClosestDistance(swFC, swFV, Nothing, Nothing)
                If temp < min Then min = temp
            Next
        Next
        Return min
    End Function


    Public Overloads Function Distance(ByRef somm As sldworks.Vertex, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = somm.GetPoint()
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
        Return Math.Sqrt(temp)

    End Function

    Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = Arete.GetClosestPointOn(x, y, z)
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)

        Return Math.Sqrt(temp)

    End Function

    Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef P() As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = Arete.GetClosestPointOn(P(0), P(1), P(2))
        dPoint = vpoints

        temp = (dPoint(0) - P(0)) * (dPoint(0) - P(0)) + (dPoint(1) - P(1)) * (dPoint(1) - P(1)) + (dPoint(2) - P(2)) * (dPoint(2) - P(2))

        Return Math.Sqrt(temp)

    End Function


    Public Overloads Function Distance(ByRef Courbe As sldworks.Curve, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = Courbe.GetClosestPointOn(x, y, z)
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)

        Return Math.Sqrt(temp)
    End Function

    Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal xyz() As Double) As Double
        Return Distance(Face, xyz(0), xyz(1), xyz(2))
    End Function

    Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = Face.GetClosestPointOn(x, y, z)
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)

        Return Math.Sqrt(temp)

    End Function

    Public Overloads Function Distance(ByRef Face As SuperFace, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        vpoints = Face.SwFace.GetClosestPointOn(x, y, z)
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)

        Return Math.Sqrt(temp)

    End Function


    Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByRef sommet As sldworks.Vertex) As Double
        Dim vpoints As Object
        Dim dPoint() As Double
        Dim temp As Double
        Dim x As Double, y As Double, z As Double


        vpoints = sommet.GetPoint()
        dPoint = vpoints
        x = dPoint(0) : y = dPoint(1) : z = dPoint(2)

        vpoints = Face.GetClosestPointOn(x, y, z)
        dPoint = vpoints

        temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)

        Return Math.Sqrt(temp)

    End Function


    Public Overloads Function distance(ByRef s1 As sldworks.Vertex, ByRef s2 As sldworks.Vertex) As Double

        Dim vpoints As Object
        Dim dPoint() As Double
        Dim dPoint2() As Double
        Dim temp As Double

        vpoints = s1.GetPoint()
        dPoint = vpoints

        vpoints = s2.GetPoint()
        dPoint2 = vpoints

        temp = (dPoint(0) - dPoint2(0)) * (dPoint(0) - dPoint2(0)) + (dPoint(1) - dPoint2(1)) * (dPoint(1) - dPoint2(1)) + (dPoint(2) - dPoint2(2)) * (dPoint(2) - dPoint2(2))
        Return Math.Sqrt(temp)

    End Function

    Public Overloads Function Distance(ByRef X1 As Double, ByRef Y1 As Double, ByRef Z1 As Double, ByRef X2 As Double, ByRef Y2 As Double, ByRef Z2 As Double) As Double
        Return Math.Sqrt((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2 + (Z2 - Z1) ^ 2)
    End Function


    Public Overloads Function distance(ByRef P1() As Double, ByRef P2() As Double) As Double
        If Not UBound(P1) = 2 And Not UBound(P2) = 2 Then MsgBox("Cette fonction de distance ne marche qu'en 3D pour l'instant")
        Return Math.Sqrt((P1(0) - P2(0)) ^ 2 + (P1(1) - P2(1)) ^ 2 + (P1(2) - P2(2)) ^ 2)
    End Function


    Public Overloads Function distance(ByRef P1() As Double, ByRef s2 As sldworks.Vertex) As Double

        Dim vpoints As Object
        Dim dPoint() As Double
        Dim dPoint2() As Double
        Dim temp As Double


        dPoint = P1

        vpoints = s2.GetPoint()
        dPoint2 = vpoints

        temp = (dPoint(0) - dPoint2(0)) * (dPoint(0) - dPoint2(0)) + (dPoint(1) - dPoint2(1)) * (dPoint(1) - dPoint2(1)) + (dPoint(2) - dPoint2(2)) * (dPoint(2) - dPoint2(2))
        Return Math.Sqrt(temp)

    End Function

    Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetCoque) As Double
        Return Distance(s1.swSommet, s2.swSommet)
    End Function

    Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetVolume) As Double
        Return Distance(s1.swSommet, s2.swSommet)
    End Function

    ''' <summary>
    ''' Distance entre un point d'esquisse et un sommet
    ''' </summary>
    ''' <param name="swPoint"></param>
    ''' <param name="SwSommet"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overloads Function Distance(ByRef swPoint As sldworks.SketchPoint, ByRef SwSommet As sldworks.Vertex) As Double
        Dim P(2) As Double
        P(0) = swPoint.X : P(1) = swPoint.Y : P(2) = swPoint.Z
        P = Commun.TransfertModelSketch(swPoint.GetSketch, P)
        Dim esom As New SuperSommet(SwSommet, True)
        Return Math.Sqrt((esom.X - P(0)) ^ 2 + (esom.Y - P(1)) ^ 2 + (esom.Z - P(2)) ^ 2)

    End Function


    Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetPoutre) As Double
        Return Distance(s1.swSommet, s2.swSommet)
    End Function

    Public Function GetLongueurArete(ByRef swArete As SldWorks.Edge) As Double
        Dim swCourbe As SldWorks.Curve
        Dim temp As Object
        Dim T1 As Double, T2 As Double
        Dim sommet As SldWorks.Vertex
        Dim point As Object

        swCourbe = swArete.GetCurve

        sommet = swArete.GetStartVertex()

        If sommet IsNot Nothing Then
            point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
            sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
            Return swCourbe.GetLength2(T1, T2)

        Else
            'l'arète est fermée.
            Dim params() As Double
            If swCourbe.IsCircle Then
                params = swCourbe.CircleParams
                Return params(7) * Pi * 2
            End If
            MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.")
        End If

    End Function


    ''' <summary>
    ''' Function qui retourne le paramètreT du milieu de l'arète
    ''' </summary>
    ''' <param name="swSrete">L'arète en question</param>
    ''' <returns>Le paramètre T de l acourbe</returns>
    ''' <remarks>Si la courbe est fermée, la fonction retourne auqnd ême le T milieu.  i.e. T = pi</remarks>
    Public Function GetTMilieu(ByRef swArete As SldWorks.Edge) As Double
        Dim swCourbe As SldWorks.Curve
        Dim temp As Object
        Dim T1 As Double, T2 As Double
        Dim sommet As SldWorks.Vertex
        Dim point As Object

        swCourbe = swArete.GetCurve

        sommet = swArete.GetStartVertex()

        If sommet IsNot Nothing Then
            point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
            sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
            Return (T1 + T2) / 2

        Else
            'l'arète est fermée.
            If swCourbe.IsCircle Then
                Return Pi
            End If
            MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.")
        End If


    End Function

    'Procédure qui repère les arètes avec des atributs et leur met une couleur
    Public Sub ColorerAretes()
        ' on fait le tour des features pour avoir les poutres et les coques
        Dim feat As SldWorks.Feature
        Dim vSupprime As Object
        Dim bSupprime As Boolean
        Dim ent As SldWorks.Entity
        Dim attr As SldWorks.Attribute
        Dim swArete As SldWorks.Edge
        'RealConstant.RegisterAttribut()
        'RealConstant.RCCode.RegisterAttribut()

        swModel.EditRebuild3()

        feat = swPart.FirstFeature

        Do While Not feat Is Nothing

            vSupprime = feat.IsSuppressed
            bSupprime = CBool(vSupprime)
            If Not bSupprime Then  ' on vérifie que l'entité est pas supprimée

                Select Case feat.GetTypeName
                    Case "CompositeCurve", "3DSplineCurve", "Helix"  'le feature est une courbe libre

                        Dim refCourbe As SldWorks.ReferenceCurve

                        refCourbe = feat.GetSpecificFeature2
                        swArete = refCourbe.GetFirstSegment
                        Do While Not swArete Is Nothing
                            Try
                                ent = swArete
                                attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
                                If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
                            Catch ex As Exception

                            End Try

                            swArete = Nothing
                            swArete = refCourbe.GetNextSegment
                        Loop
                End Select

            End If ' fin du if sur la suppression du feature
            feat = feat.GetNextFeature
        Loop
    End Sub

    ' procédure de débuggage qui place un point là où on le demande. (avec un sketch3D)
    Public Overloads Sub MettreUnPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Selection As Boolean = False)
        Dim point As sldworks.SketchPoint
        swModel.Insert3DSketch2(True)
        point = swModel.CreatePoint2(x, y, z)
        swModel.Insert3DSketch2(False)
        'swModel.EditRebuild3()
        If Selection Then
            point.Select2(False, 0)
        End If
    End Sub

    Public Overloads Function MettreUnPoint(ByRef Plan As sldworks.RefPlane, ByRef x As Double, ByRef y As Double, ByRef z As Double) As sldworks.SketchPoint
        Dim swent As sldworks.Entity
        Dim p(2) As Double
        p(0) = x
        p(1) = y
        p(2) = z
        swent = Plan
        swent.Select4(False, Nothing)
        swModel.InsertSketch2(True)
        p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
        MettreUnPoint = swModel.CreatePoint2(p(0), p(1), p(2))
        swModel.InsertSketch2(False)
        swModel.EditRebuild3()
    End Function

    Public Overloads Function MettreUneLigne(ByRef Plan As sldworks.RefPlane, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
        Dim swent As sldworks.Entity
        Dim p(2) As Double, p2(2) As Double
        p(0) = x1 : p(1) = y1 : p(2) = z1
        p2(0) = x2 : p2(1) = y2 : p2(2) = z2
        swent = Plan
        swent.Select4(False, Nothing)
        swModel.InsertSketch2(True)
        p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
        p2 = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p2)
        MettreUneLigne = swModel.CreateLine2(p(0), p(1), p(2), p2(0), p2(1), p2(2))
        swModel.InsertSketch2(False)
        swModel.EditRebuild3()
    End Function

    Public Overloads Function MettreUneLigne(ByRef face As sldworks.Face2, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
        Dim swent As sldworks.Entity
        Dim p(2) As Double, p2(2) As Double
        p(0) = x1 : p(1) = y1 : p(2) = z1
        p2(0) = x2 : p2(1) = y2 : p2(2) = z2
        swent = face
        swent.Select4(False, Nothing)
        swModel.InsertSketch2(True)
        p = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p)
        p2 = Commun.TransfertModelSketch(swModel.GetActiveSketch2(), p2)
        MettreUneLigne = swModel.CreateLine2(p(0), p(1), p(2), p2(0), p2(1), p2(2))
        swModel.InsertSketch2(False)
        swModel.EditRebuild3()
    End Function

    ''' <summary>
    ''' Créé une ligne dans un sketch selon ses 2 points d'extrémités
    ''' </summary>
    ''' <param name="P"></param>
    ''' <param name="P2"></param>
    ''' <remarks></remarks>
    Public Overloads Sub MettreUneLigne(ByRef P() As Double, ByRef P2() As Double)
        swModel.Insert3DSketch2(False)
        swModel.CreateLine2(P(0), P(1), P(2), P2(0), P2(1), P2(2))
        swModel.Insert3DSketch2(False)
        swModel.EditRebuild3()
    End Sub


    Public Sub EffacerAnnoEtCoord()
        Dim anno As sldworks.Annotation
        Dim ent As sldworks.Entity
        Dim prochainAnno As sldworks.Annotation

        anno = swModel.GetFirstAnnotation2

        Do While Not anno Is Nothing
            anno.Select(False)
            prochainAnno = anno.GetNext3()
            swModel.EditDelete()
            anno = prochainAnno
        Loop


        ' parcours des features pour éliminer les Points3
        Dim feat As sldworks.Feature
        Dim nextfeat As sldworks.Feature
        feat = swPart.FirstFeature

        Do While Not feat Is Nothing
            If feat.GetTypeName = "CoordSys" Then
                nextfeat = feat.GetNextFeature
                ent = feat
                ent.Select2(False, Nothing)
                swModel.EditDelete()
                feat = nextfeat
            Else
                feat = feat.GetNextFeature()
            End If
        Loop


    End Sub

    Sub MettreAttributPourFaceInterne(ByRef swFaceInterne As sldworks.Face2)
        ' Sub qui place l'attribut de faceinterne sur une face
        Dim attr As sldworks.Attribute
        Dim swent As sldworks.Entity
        Static no As Integer = 1
        Dim nom2 As String

        nom2 = "FaceInterne #" & no
        swent = swFaceInterne
        attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.

        If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFaceInterne, nom2, 0, 2) ' 0 = swThisconfig

        While attr Is Nothing
            nom2 = "FaceInterne" & CStr(no)
            attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFaceInterne, nom2, 0, 0)
            no += 1
        End While
        GererDossiers("FaceInternes", nom2)
        no += 1
    End Sub

    Private Function Ignorer(ByRef swArete As sldworks.Edge) As Boolean
        Dim attr As sldworks.Attribute
        Dim SwEnt As sldworks.Entity
        Dim p As sldworks.Parameter
        SwEnt = swArete
        attr = SwEnt.FindAttribute(Intersections.DefAttrIgnorer, 0)
        If attr Is Nothing Then Return False Else Return True
    End Function

    Public Sub GetMidPointSegment(ByVal seg As sldworks.SketchSegment, ByRef x As Double, ByRef y As Double, ByRef z As Double)
        Dim curve As sldworks.Curve
        Dim start As Double
        Dim pend As Double
        Dim isClosed As Boolean
        Dim isPeriodic As Boolean
        Dim milieu As Double
        Dim vXYZ As Object
        Dim xyz(2) As Double

        curve = seg.GetCurve
        curve.GetEndParams(start, pend, isClosed, isPeriodic)

        milieu = (pend + start) / 2

        vXYZ = curve.Evaluate(milieu)

        xyz = vXYZ

        x = xyz(0) : y = xyz(1) : z = xyz(2)

    End Sub

    Public Sub SelectFaceByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
        Dim swent As sldworks.Entity
        swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelFACES)
        swent.Select4(append, Nothing)
    End Sub

    Public Sub SelectAreteByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
        Dim swent As sldworks.Entity
        swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelEDGES)
        swent.Select4(append, Nothing)
    End Sub

    Public Sub SelectSommetByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
        Dim swent As sldworks.Entity
        swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelVERTICES)
        swent.Select4(append, Nothing)
    End Sub

    Public Function DessineCourbe(ByRef curve As sldworks.Curve) As sldworks.SketchSegment
        Dim modeler As sldworks.Modeler
        Dim vp1 As Object : Dim P1() As Double
        Dim vp2 As Object : Dim P2() As Double
        Dim dir(2) As Double
        Dim sketchseg As sldworks.SketchSegment = Nothing
        Dim i As Integer
        Dim Tmax As Double, Tmin As Double
        Dim ajout As Double

        Dim isPeriodic As Boolean : Dim isClosed As Boolean

        If curve.IsTrimmedCurve Then
            If curve.IsLine Then
                swModel.Insert3DSketch2(False)
                curve.GetEndParams(Tmin, Tmax, isClosed, isPeriodic)
                vp1 = curve.Evaluate(Tmin)
                vp2 = curve.Evaluate(Tmax)
                sketchseg = swModel.CreateLine2(vp1(0), vp1(1), vp1(2), vp2(0), vp2(1), vp2(2))
                swModel.Insert3DSketch2(False)
                Return sketchseg
            End If

        Else
            curve.GetEndParams(Tmin, Tmax, isClosed, isPeriodic)
            modeler = swApp.GetModeler
            swModel.Insert3DSketch2(False)
            ajout = (Tmax - Tmin) / 100
            vp1 = curve.Evaluate(Tmin) : P1 = vp1
            For i = 1 To 100
                vp2 = curve.Evaluate(Tmin + i * ajout) : P2 = vp2
                sketchseg = swModel.CreateLine2(P1(0), P1(1), P1(2), P2(0), P2(1), P2(2))
                P1 = P2
            Next i
            swModel.Insert3DSketch2(False)

            'modeler = swApp.GetModeler
            'For i = 1 To 100
            '    vp2 = curve.Evaluate(Tmin + i * ajout)
            '    modeler.CreateLine(vp1, vp2)
            '    vp1 = vp2
            'Next i
            Return sketchseg
        End If
        Return Nothing
    End Function

    Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef P() As Double) As Double
        ' function qui trouve l'angle entre 2 faces au point spécifié...
        Return AngleEntre2Faces(swface1, swface2, P(0), P(1), P(2))
    End Function

    Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
        ' function qui trouve l'angle entre 2 faces au point spécifié...
        Dim swSurf As sldworks.Surface
        Dim retval As Object
        Dim Normale1(2) As Double
        Dim Normale2(2) As Double

        swSurf = swface1.GetSurface
        retval = swSurf.EvaluateAtPoint(x, y, z)
        Normale1(0) = retval(0) : Normale1(1) = retval(1) : Normale1(2) = retval(2)

        swSurf = swface2.GetSurface
        retval = swSurf.EvaluateAtPoint(x, y, z)
        Normale2(0) = retval(0) : Normale2(1) = retval(1) : Normale2(2) = retval(2)

        Return Outils_Math.Angle2Vecteurs(Normale1, Normale2)
    End Function


    Public Sub Test()
        ' se déclenche quand on apuie sur le bouton 4

        Dim lst As New Collections.ObjectModel.Collection(Of sldworks.Vertex)

        Intersections.RegisterAttribut()

        swModel.EditRebuild3()
        ' on fait le tour des features pour avoir les poutres et les coques
        Dim feat As sldworks.Feature
        Dim vSupprime As Object
        Dim bSupprime As Boolean
        Dim attr As sldworks.Attribute
        Dim swArete As sldworks.Edge
        Dim swSommet1 As sldworks.Vertex
        Dim swSommet2 As sldworks.Vertex

        feat = swPart.FirstFeature

        Do While Not feat Is Nothing

            vSupprime = feat.IsSuppressed
            bSupprime = CBool(vSupprime)
            If Not bSupprime Then  ' on vérifie que l'entité est pas supprimée

                Select Case feat.GetTypeName
                    Case "CompositeCurve", "3DSplineCurve", "Helix"  'le feature est une courbe libre

                        Dim refCourbe As sldworks.ReferenceCurve
                        refCourbe = feat.GetSpecificFeature2
                        swArete = refCourbe.GetFirstSegment
                        Do While Not swArete Is Nothing

                            If (Not Ignorer(swArete)) Then

                                swSommet1 = swArete.GetStartVertex
                                lst.Add(swSommet1)

                                If IsNothing(swSommet1) Then
                                    'MsgBox("On a une courbe sans sommet")
                                Else
                                    swSommet2 = swArete.GetEndVertex
                                    lst.Add(swSommet2)
                                End If
                            End If

                            swArete = Nothing
                            swArete = refCourbe.GetNextSegment

                        Loop

                    Case Else ' n'est pas un feature intéressant...
                        ' rien
                End Select
            End If ' fin du if sur la suppression du feature
            feat = feat.GetNextFeature
        Loop


        Dim swEnt As sldworks.Entity
        For Each s As sldworks.Vertex In lst
            swEnt = s
            attr = swEnt.FindAttribute(DefAttrDoublon, 0)
            If Not attr Is Nothing Then
                Dim p As sldworks.Parameter = attr.GetParameter("Maitre")
                MsgBox(p.GetStringValue)
            End If
        Next

    End Sub


    ''' <summary>
    ''' Sub qui dessine avec des corps temporaires le sens des arètes et la normale des faces.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub DessinerSensAretesEtNormaleFace()

        Try
            Dim lst_fleches_Face As New Collections.Generic.List(Of sldworks.Body2)
            Dim lst_fleches_Arete As New Collections.Generic.List(Of sldworks.Body2)
            Dim lst_fleches_CoArete As New Collections.Generic.List(Of sldworks.Body2)
            Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
            Dim ext As sldworks.ModelDocExtension = swModel.Extension
            Dim normale(2) As Double

            Dim swMprop As sldworks.MassProperty = swModel.Extension.CreateMassProperty
            Dim volume As Double = swMprop.Volume
            Dim surface As Double = swMprop.SurfaceArea
            Dim Grosseur As Double = (volume / surface) / 4
            Dim centreX, centreY, centreZ As Double
            Dim Dx, Dy, Dz As Double
            Dim D(2) As Double
            Dim bod As sldworks.Body2

            ' pour dessiner les normales
            Dim swFace As sldworks.Face2
            Dim swEnt As sldworks.Entity

            For ff As Integer = 1 To selmgr.GetSelectedObjectCount
                If selmgr.GetSelectedObjectType3(ff, -1) = swconst.swSelectType_e.swSelFACES Then
                    swEnt = selmgr.GetSelectedObject6(ff, -1)
                    swFace = swEnt
                Else
                    Continue For
                End If

                Dim F As New SuperFace(swFace, True)
                Dim Umin As Double, Umax As Double, Vmin As Double, Vmax As Double, U As Double, V As Double
                Dim i As Integer, j As Integer, Uinc As Double, Vinc As Double


                F.UVMinMax(Umin, Umax, Vmin, Vmax)
                V = Vmin
                U = Umin
                Uinc = (Umax - Umin) / 5
                Vinc = (Vmax - Vmin) / 5

                For i = 1 To 4
                    U += Uinc
                    V = Vmin
                    For j = 1 To 4
                        V += Vinc

                        If F.Evaluer(U, V, centreX, centreY, centreZ) Then
                            normale = F.Normale(centreX, centreY, centreZ)
                            Dx = normale(0) : Dy = normale(1) : Dz = normale(2)
                            bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, Dx, Dy, Dz, 255, 0, 0, Grosseur)
                            lst_fleches_Face.Add(bod)
                        End If
                    Next j
                Next i


                ' mémoriser les points des aretes
                'Dim vEdge As Object = swFace.GetEdges
                Dim loope As sldworks.Loop2 = swFace.GetFirstLoop

                While loope IsNot Nothing

                    Dim CoArete As sldworks.CoEdge = loope.GetFirstCoEdge

                    For coa As Integer = 0 To loope.GetEdgeCount - 1

                        Dim swArete As sldworks.Edge
                        swArete = CoArete.GetEdge
                        'For Each swArete As sldworks.Edge In vEdge
                        Dim a As New SuperArete(swArete, True)
                        Dim Tmin As Double, Tmax As Double
                        Dim incT As Double, T As Double

                        Tmax = a.GetTMax()
                        Tmin = a.GetTMin
                        incT = (Tmax - Tmin) / 5

                        T = Tmin
                        a.Evaluer(T, centreX, centreY, centreZ)
                        D = a.GetTangence(T)
                        bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
                        lst_fleches_Arete.Add(bod)

                        T = Tmin + 1 * incT
                        a.Evaluer(T, centreX, centreY, centreZ)
                        D = a.GetTangence(T)
                        bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
                        lst_fleches_Arete.Add(bod)

                        T = Tmin + 2 * incT
                        a.Evaluer(T, centreX, centreY, centreZ)
                        D = a.GetTangence(T)
                        bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
                        lst_fleches_Arete.Add(bod)


                        T = Tmin + 3 * incT
                        a.Evaluer(T, centreX, centreY, centreZ)
                        D = a.GetTangence(T)
                        If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
                        bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
                        lst_fleches_CoArete.Add(bod)

                        T = Tmin + 4 * incT
                        a.Evaluer(T, centreX, centreY, centreZ)
                        D = a.GetTangence(T)
                        If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
                        bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
                        lst_fleches_CoArete.Add(bod)

                        CoArete = CoArete.GetNext
                    Next coa ' coarete
                    loope = loope.GetNext
                End While ' loope

            Next ff


            For Each body As sldworks.Body2 In lst_fleches_Face
                body.Display3(swPart, 1, 0)
            Next

            For Each body As sldworks.Body2 In lst_fleches_Arete
                body.Display3(swPart, RGB(255, 0, 0), 0)
            Next

            For Each body As sldworks.Body2 In lst_fleches_CoArete
                body.Display3(swPart, RGB(200, 0, 200), 0)
            Next

        Catch ex As Exception
            swApp.SendMsgToUser2("Ça n'a pas marché!", swconst.swMessageBoxIcon_e.swMbInformation, swconst.swMessageBoxBtn_e.swMbOk)
        End Try


    End Sub


    ''' <summary>
    ''' Dessine une flèche temporaire (temp. Body)
    ''' </summary>
    ''' <param name="CentreX"></param>
    ''' <param name="centreY"></param>
    ''' <param name="centreZ"></param>
    ''' <param name="Dx"></param>
    ''' <param name="Dy"></param>
    ''' <param name="Dz"></param>
    ''' <param name="Rouge"></param>
    ''' <param name="Vert"></param>
    ''' <param name="Bleu"></param>
    ''' <param name="Grosseur"></param>
    ''' <returns>Le Body2 représentant la flèche</returns>
    ''' <remarks></remarks>
    Public Function FlecheTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, Optional ByVal Rouge As Integer = 255, Optional ByVal Vert As Integer = 0, Optional ByVal Bleu As Integer = 0, Optional ByVal Longueur As Double = 1) As sldworks.Body2
        Dim P(2) As Double
        Dim Bod1, bod2 As sldworks.Body2
        Dim vBod As Object
        Dim errcode As Integer

        Bod1 = CylindreTemporaire(CentreX, centreY, centreZ, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))

        P(0) = Dx : P(1) = Dy : P(2) = Dz
        P = Outils_Math.unitaire(P)
        bod2 = ConeTemporaire(CentreX + P(0) * Longueur, centreY + P(1) * Longueur, centreZ + P(2) * Longueur, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))
        vBod = Bod1.Operations2(swconst.swBodyOperationType_e.SWBODYADD, bod2, errcode)
        Return vBod(0)

    End Function


    ''' <summary>
    ''' Dessine un cylindre avec un temporary body
    ''' </summary>
    ''' <param name="CentreX"></param>
    ''' <param name="centreY"></param>
    ''' <param name="centreZ"></param>
    ''' <param name="Dx"></param>
    ''' <param name="Dy"></param>
    ''' <param name="Dz"></param>
    ''' <param name="longueur"></param>
    ''' <param name="couleur"></param>
    ''' <remarks></remarks>
    Public Function CylindreTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
        Dim View As sldworks.ModelView = swModel.ActiveView()
        Dim swModeler As sldworks.Modeler = swApp.GetModeler
        Dim NewBod As sldworks.Body2
        Dim liste(7) As Double, vListe As Object

        liste(0) = CentreX  ' les 3 points de centre
        liste(1) = centreY
        liste(2) = centreZ
        liste(3) = Dx    ' l'axe du cone 
        liste(4) = Dy
        liste(5) = Dz
        liste(6) = longueur / 6 ' radius, le 1/6 de la longueur
        liste(7) = longueur  ' hauteur

        vListe = liste
        NewBod = swModeler.CreateBodyFromCyl(vListe)
        NewBod.Display2(swPart, couleur, 0)
        Return NewBod
    End Function

    ''' <summary>
    ''' Dessine un cone avec un temporary body
    ''' </summary>
    ''' <param name="CentreX"></param>
    ''' <param name="centreY"></param>
    ''' <param name="centreZ"></param>
    ''' <param name="Dx"></param>
    ''' <param name="Dy"></param>
    ''' <param name="Dz"></param>
    ''' <param name="longueur"></param>
    ''' <param name="couleur"></param>
    ''' <remarks></remarks>
    Public Function ConeTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
        Dim View As sldworks.ModelView = swModel.ActiveView()
        Dim swModeler As sldworks.Modeler = swApp.GetModeler
        Dim liste(8) As Double, vListe As Object
        Dim NewBod As sldworks.Body2

        liste(0) = CentreX  ' les 3 points de centre
        liste(1) = centreY
        liste(2) = centreZ
        liste(3) = Dx    ' l'axe du cone 
        liste(4) = Dy
        liste(5) = Dz
        liste(6) = longueur / 2 ' base radius
        liste(7) = 0 'top radius
        liste(8) = longueur ' hauteur
        vListe = liste
        NewBod = swModeler.CreateBodyFromCone(vListe)
        NewBod.Display2(swPart, couleur, 0)
        Return NewBod
    End Function


    ''' <summary>
    ''' Créer une annotation qui pointe sur les coordonnées spécifiées
    ''' </summary>
    ''' <param name="x">La flèche de l'annotation pointera dessu.</param>
    ''' <param name="y"></param>
    ''' <param name="z"></param>
    ''' <param name="Texte">Le texte à y écrire</param>
    ''' <remarks></remarks>
    Public Sub CreerAnnotation(ByVal x As Double, ByVal y As Double, ByVal z As Double, Optional ByVal Texte As String = " NT ")
        Commun.MettreUnPoint(x, y, z, True)
        Dim swNote As sldworks.Note
        swNote = swModel.InsertNote(Texte)
    End Sub


    Public Class Point
        Public X As Double
        Public Y As Double
        Public Z As Double

        ''' <summary>
        ''' Attention de ne pas oublier de fixer les valeurs de x,y et z plus tard.
        ''' </summary>
        ''' <remarks></remarks>
        Public Sub New()

        End Sub

        Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double)
            Me.X = x : Me.Y = y : Me.Z = z
        End Sub

        Public Shared Operator =(ByVal P1 As Point, ByVal P2 As Point) As Boolean
            If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return True Else Return False
        End Operator

        Public Shared Operator <>(ByVal P1 As Point, ByVal P2 As Point) As Boolean
            If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return False Else Return True
        End Operator

        Public Shared Narrowing Operator CType(ByVal P As Point) As String
            Return (Replace(CStr(P.X), ",", ".") & " " & Replace(CStr(P.Y), ",", ".") & " " & Replace(CStr(P.Z), ",", "."))
        End Operator


    End Class


End Module
Revision:	205
Committed:	Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size:	69315 byte(s)
Log Message:	Commit de MAGiC_SLD pendant que j'y pense. Les modifications ne devraient pas concerner personne d'autre que moi. -- Sylvain