REPOS_ERICCA/magicsld/SuperArete.vb

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

Public Class SuperArete
    Inherits SuperEntite
    Public swArete As SldWorks.Edge
    Private Shared compteur As Long
    Private Shared no As Long

    Protected swCourbe As SldWorks.Curve


    ''' <summary>
    '''  Le new pour un encapsulateur de l'arète
    ''' </summary>
    ''' <param name="swArete"></param>
    ''' <param name="encapsulateur"></param>
    ''' <remarks></remarks>
    Public Sub New(ByRef swArete As SldWorks.Edge, ByRef encapsulateur As Boolean)
        Me.swArete = swArete
        Me.swCourbe = swArete.GetCurve


    End Sub


    Public Sub New(ByRef arete As SldWorks.Edge, Optional ByVal tip As Integer = 0)
        Me.swArete = arete
        Me.swCourbe = swArete.GetCurve
        Select Case tip
            Case Commun.tipe_e.Volume
                nom = "Arete" & compteur
            Case Commun.tipe_e.coque
                nom = "AreteCoque" & compteur
            Case Commun.tipe_e.poutre
                nom = "AretePoutre" & compteur
            Case Commun.tipe_e.MiniPoutre
                nom = "Mini-Poutre" & compteur
        End Select
        nomOrig = nom
        compteur = compteur + 1
    End Sub


    Public Overrides Sub SaveNom()
        ' procédure qui enregistre le nom et qui , pour l'instant ne tient pas compte des conditions aux limites
        Dim ent As SldWorks.Entity
        ent = swArete
        Dim retval As Boolean

        Try
            retval = swPart.SetEntityName(ent, nom)
        Catch


            Dim i As Integer
            If retval = False Then
                Do Until retval = True
                    i += 1
                    retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
                Loop
                Me.nom = nom & Chr(96 + i)
                'MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom) ' MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom, MsgBoxStyle.Critical, "Problème dans le setID de l'arrète")
            End If
            MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) ' MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom)
        End Try
    End Sub

    Shared Sub reinitialiser()
        compteur = 0
    End Sub

    Public Function GetOrientation(ByRef T As Double) As Double()
        'retval = Edge.Evaluate ( Parameter)  retval est un tableau, 4,5 et 6 sont les tangentes au point...

        Dim temp(2) As Double
        Dim retval As Object

        retval = Me.swArete.Evaluate(T)

        temp(0) = retval(3)
        temp(1) = retval(4)
        temp(2) = retval(5)

        Return temp

    End Function

    Public Function GetOrientation(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double()
        Dim retval As Object
        retval = Me.swArete.GetClosestPointOn(x, y, z)
        Return GetOrientation(retval(3))
    End Function


    Public Sub MettreAttributPourConditionLimite()
        Dim swent As SldWorks.Entity
        Dim nom As String
        Dim cond As String

        cond = Me.condition
        If cond = "" Then Exit Sub

        swent = Me.swArete

        nom = "CL" & CStr(no) & "_" & cond
        Dim Attr As SldWorks.Attribute = Nothing

        Try
            Attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
        Catch ex As Exception
            MsgBox("N'arrive pas à se lier à l'attribut, erreur: " & ex.Message, MsgBoxStyle.Critical)
        End Try

        ' si nothing c'est que l'attribut n'existe pas
        If Attr Is Nothing Then Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swArete, nom, 0, 2) ' 0 = swThisconfig, 2 = allconfig

        While Attr Is Nothing
            no += 1
            nom = "CL" & CStr(no) & "_" & cond
            Attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, Me.swArete, nom, 0, 2)
        End While

        Dim ParamCL As SldWorks.Parameter
        ParamCL = Attr.GetParameter("CL")

        ParamCL.SetStringValue2(cond, 2, "")  ' swAllConfiguration = 2

        GererDossiers("Conditions Aux Limites", nom)
        no = no + 1

    End Sub


    ' une fonction qui transforme un attribut en condition aux limites
    Public Sub AttributVersConditionLimite()
        Dim p As SldWorks.Parameter
        Dim ent As SldWorks.Entity
        Dim attr As SldWorks.Attribute

        ent = Me.swArete
        attr = ent.FindAttribute(Intersections.DefAttrConditionLimite, 0)
        If Not attr Is Nothing Then
            p = attr.GetParameter("CL")
            nom = nomOrig & "@" & p.GetStringValue
        End If

    End Sub


    Public Function GetSwSommets() As SldWorks.Vertex()
        Dim swsommet(1) As SldWorks.Vertex
        swsommet(0) = Me.swArete.GetStartVertex()
        If swsommet(0) Is Nothing Then Return Nothing
        swsommet(1) = Me.swArete.GetEndVertex
        Return swsommet
    End Function

    Public Overrides Sub Selectionner(Optional ByVal Mark As Integer = 0, Optional ByRef Append As Boolean = True)
        Dim swent As SldWorks.Entity
        swent = swArete
        swent.Select2(Append, Mark)
    End Sub


    ''' <summary>
    '''  Renvoie les coordonnées du point milieu
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>Attention: Ce sont les coordonnées du point à T milieu, ce qui n'est pas nécessairement le milieu de l'arète dans le cas de b-spline </remarks>
    Public Function GetPointMilieu(Optional ByVal Reverse As Boolean = False) As Double()
        Dim T As Double
        Dim xyz(2) As Double
        T = Me.GetTMilieu(Reverse)
        Me.Evaluer(T, xyz)
        Return xyz
    End Function

    ''' <summary>
    '''  Renvoie les coordonnées du point milieu
    ''' </summary>
    ''' <returns>Faux si le sommet n'existe pas</returns>
    ''' <remarks></remarks>
    Public Function GetPointMilieu(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Reverse As Boolean = False) As Boolean
        Dim T As Double
        T = Me.GetTMilieu(Reverse)
        Me.Evaluer(T, x, y, z)
        Return True
    End Function


    ''' <summary>
    ''' Détermine si une courbe est une ligne
    ''' </summary>
    ''' <returns>Vrai si la courbe est une ligne</returns>
    ''' <remarks></remarks>
    Public Function IsLine() As Boolean

        Dim ev As Object = Me.swArete.Evaluate(0.2)
        Dim cr As sldworks.Curve = Me.swArete.GetCurve

        Try
            Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve
            Select Case swCourbe.Identity()

                Case swconst.swCurveTypes_e.LINE_TYPE
                    Return True

                Case Else
                    Return False
            End Select

        Catch
            ' on a un drole de type de courbe... on ne peut dire si c'est une ligne ou autre...
            Try
                Dim swCourbe2 As sldworks.Curve = swCourbe.GetBaseCurve
                Select Case swCourbe2.Identity()

                    Case swconst.swCurveTypes_e.LINE_TYPE
                        Return True

                    Case Else
                        Return False
                End Select
            Catch ex As Exception

            End Try


            Return False
        End Try

    End Function


    ''' <summary>
    ''' Retourne vrai si la courbe est fermée
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property IsClosed() As Boolean
        Get
            If Me.swArete.GetStartVertex Is Nothing Then Return False Else Return True
        End Get
    End Property

    ''' <summary>
    ''' Détermine si la courbe est un cercle
    ''' </summary>
    ''' <returns>Vrai si la courbe est un cercle</returns>
    ''' <remarks></remarks>
    Public Function IsCircle() As Boolean

        Try

            If Me.swCourbe.IsLine Then Return False
            Return Me.swCourbe.IsCircle
        Catch ex As Exception
            Dim fault As sldworks.FaultEntity = Me.swArete.Check
            Debug.WriteLine("N'arrive pas à déterminer si la courbe est un cercle" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom)

            Try
                If swCourbe.Identity() = swconst.swCurveTypes_e.CIRCLE_TYPE Then Return True Else Return False

            Catch
                Debug.Print("Même merde que pour la ligne, le lien entre la courbe et le pointeur se perd par magie!")
            End Try

            Return False
        End Try

    End Function

    ''' <summary>
    ''' Détermine si la courbe est une B-Spline
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>Vrai si la courbe est une b-spline</remarks>
    Public Function IsBcurve() As Boolean
        Try
            Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve
            If swCourbe.IsLine Then Return False
            If swCourbe.IsCircle Then Return False ' le manuel dit de vérifier ça avant de demander pour une Spline...
            Return swCourbe.IsBcurve()
        Catch
            Dim fault As SldWorks.FaultEntity = Me.swArete.Check
            Debug.WriteLine("N'arrive pas à déterminer si la courbe est une spline" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom)
            Return False
        End Try
    End Function

    ''' <summary>
    ''' Détermine si la courbe est une ellipse
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>Vrai si ellipse</remarks>
    Public Function IsEllipse() As Boolean
        Try
            Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve
            If swCourbe.IsLine Then Return False
            Return swCourbe.IsEllipse
        Catch
            Dim fault As SldWorks.FaultEntity = Me.swArete.Check
            Debug.WriteLine("N'arrive pas à déterminer si la courbe est une ellipse" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom)
        End Try

    End Function


    ''' <summary>
    ''' Sub pour sélectionner l'arète dans la fenètre de solidworks
    ''' </summary>
    ''' <param name="Append"></param>
    ''' <remarks></remarks>
    Public Sub sélectionner(Optional ByVal Append As Boolean = False)
        Dim swent As SldWorks.Entity
        swent = Me.SwArete
        swent.Select2(Append, 0)
    End Sub

    ''' <summary>
    ''' Sub qui colore une arète
    ''' </summary>
    ''' <param name="Largeur">La largeur de la ligne</param>
    ''' <param name="Rouge">Le ton de rouge, entre 0 et 1</param>
    ''' <param name="Vert">Le ton de vert, entre 0 et 1</param>
    ''' <param name="Bleu">Le ton de bleu, entre 0 et 1</param>
    ''' <remarks></remarks>
    Public Sub Colorer(Optional ByVal Largeur As Integer = 2, Optional ByRef Rouge As Double = 1, Optional ByRef Vert As Double = 0, Optional ByRef Bleu As Double = 0)
        swArete.Display(Largeur, Rouge, Vert, Bleu, True)
    End Sub


    ''' <summary>
    ''' Sub qui met ou Update les paramètres des doublons des arètes.  Une entité avec un attribut de doublon est ignoré par MAGiC
    ''' </summary>
    ''' <param name="Numero">Le numéro que l'on veut attribuer</param>
    ''' <param name="Maitre">Si ce,st un maitre on met true</param>
    ''' <param name="NomMaitre">Le nom du maitre si on le connait.</param>
    ''' <remarks>Il faut toujours effacer l'attribut du maitreé... ou s'assurer que dans MAGiC on ignore "Inconnu"... De plus, si l'attribut existe déjà, le numéro devient innutile.</remarks>
    Public Sub MettreAttributDoublon(Optional ByRef Numero As Integer = 0, Optional ByRef Maitre As Boolean = False, Optional ByRef NomMaitre As String = Nothing)
        Dim attr As SldWorks.Attribute
        Dim swent As SldWorks.Entity
        Dim nom As String
        Dim ParamMaitre As SldWorks.Parameter
        Dim paramSens As SldWorks.Parameter
        Dim sens As Double = -5

        'mettre un attribut et l'updater...
        swent = Me.SwArete

        nom = "DoublonA_" & Format(Numero, "000")
        If Maitre Then nom &= "Maitre" Else nom &= "Esclave"

        attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)

        Do While attr Is Nothing
            nom = "DoublonA_" & Format(Numero, "000")
            If Maitre Then nom &= "Maitre" Else nom &= "Esclave"
            attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, swArete, nom, 0, 2) ' 0 = swThisconfig
            If attr Is Nothing Then Numero += 1
        Loop

        ParamMaitre = attr.GetParameter("Maitre")
        paramSens = attr.GetParameter("Sens")
        If NomMaitre = Nothing Then
            NomMaitre = "Inconnu"

        Else ' il faut mettre les attribut de doublons sur les sommets.
            Dim swSommet1 As SldWorks.Vertex
            Dim swSommet2 As SldWorks.Vertex

            swSommet1 = Me.SwArete.GetStartVertex()
            If swSommet1 IsNot Nothing Then
                swSommet2 = Me.SwArete.GetEndVertex
                Dim esom1 As New SuperSommet(swSommet1, True)
                Dim esom2 As New SuperSommet(swSommet2, True)
                Dim premier As Boolean = False
                Dim second As Boolean = False

                Dim SlySommetTest As SlySommetVolume

                For Each SlySommetTest In Commun.lst_SommetVolume
                    If Not premier AndAlso Distance(esom1.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then ' on vient de trouver le sommet du volume
                        esom1.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet)
                        premier = True
                    ElseIf Distance(esom2.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then
                        esom2.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet)
                        second = True
                    End If
                    If premier AndAlso second Then Exit For
                Next

            End If

            ' trouver si le sens est le même, mettre 1 si oui, et -1 si non.
            ' on met 1 si les 2 startvertex sont au même endroit, -1 si ce n'est pas le cas

            Dim a As SuperArete = Nothing
            Dim trouve As Boolean = False
            Dim som1 As SldWorks.Vertex, som2 As SldWorks.Vertex
            For Each a In Commun.lst_AreteVolume
                If a.nom = NomMaitre Then trouve = True : Exit For
            Next

            If Not trouve Then
                For Each a In Commun.lst_AreteCoque
                    If a.nom = NomMaitre Then Exit For
                Next
            End If


            som1 = Me.swArete.GetStartVertex
            If som1 IsNot Nothing Then
                som2 = a.swArete.GetStartVertex
                If som2 Is Nothing Then a.Colorer(4, 0.5, 0, 0.5) : Me.Colorer(4, 1, 0, 1) : MsgBox(a.nom & "  " & Me.nom & "Comparer = " & Me.comparer(a.swArete))
                If Distance(som1, som2) < Epsilon Then sens = 1 Else sens = -1
            Else ' wouch!, si on a une courbe fermée, comment on trouve le sens de l'arête maitre comparé à l'arète esclave.
                ' si les 2 arètes sont une par-dessus l'autre, alors je prend le point à t=0 et le T du point équivalent sur l'arète esclave
                ' si T+ deltaT = le même point sur l'arète esclave alors Bingo, même sens

                ' a est la Slyarete du maitre, Me est l'arète esclave
                Dim x, y, z, T2, T3 As Double
                Dim ret As Boolean = Me.Evaluer(0, x, y, z)
                T2 = a.GetT(x, y, z)
                Me.Evaluer(0.1, x, y, z)
                T3 = a.GetT(x, y, z)
                If T3 = (T2 + 0.1) Then sens = 1 Else sens = -1
            End If

        End If

        paramSens.SetDoubleValue2(sens, 2, "")
        ParamMaitre.SetStringValue2(NomMaitre, 2, "")  ' swAllConfiguration = 2
        'GererDossiers("Doublons", nom)

        ' Me.Colorer(2, 1, 1, 0)

    End Sub


    ''' <summary>
    ''' Met un attribut sur l'arête pour qu'elle soit ignorée
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub MettreAttributIgnorer()
        Dim attr As sldworks.Attribute
        Dim swEnt As sldworks.Entity
        Dim nom As String = Nothing
        Dim i As Integer

        swEnt = Me.swArete

        attr = swEnt.FindAttribute(Intersections.DefAttrIgnorer, 0)

        While attr Is Nothing
            nom = "Ignorer" & CStr(i)
            attr = Intersections.DefAttrIgnorer.CreateInstance5(swModel, swEnt, nom, 0, swconst.swInConfigurationOpts_e.swAllConfiguration)
            i += 1
        End While

    End Sub


    ''' <summary>
    ''' sub qui efface l'attribut du doublon sur l'arète maitre.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub EffacerAttributDoublon()
        Dim attr As SldWorks.Attribute
        Dim swent As SldWorks.Entity
        swent = Me.SwArete
        attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
        attr.Delete(True)
    End Sub


    ''' <summary>
    ''' Retourne vrai si l'arête a un attribut pour ignorer
    ''' </summary>
    ''' <returns>Vrai si on doit ignorer l'arête</returns>
    ''' <remarks></remarks>
    Public Function Ignorer() As Boolean
        Dim attr As sldworks.Attribute
        Dim swent As sldworks.Entity
        swent = Me.swArete
        attr = swent.FindAttribute(Intersections.DefAttrDoublon, 0)
        If attr Is Nothing Then Return False Else Return True
    End Function

    ''' <summary>
    ''' Function qui retourne le nom qui est sur une arète
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function getNom() As String
        Dim swEnt As SldWorks.Entity
        swEnt = swArete
        getNom = swPart.GetEntityName(swEnt)
    End Function


    ''' <summary>
    ''' Calcule et retourne le T au milieu de l'arète
    ''' </summary>
    ''' <param name="Reverse">Si oui, alors oon retourne le milieu de la courbe inversée.  Le «milieu» n'est pas le même si on a une spline...</param>
    ''' <returns>Le T du milieu</returns>
    ''' <remarks></remarks>
    Public Function GetTMilieu(Optional ByVal Reverse As Boolean = False) 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 = Me.swArete.GetCurve
        If Reverse Then swCourbe = swCourbe.ReverseCurve()

        sommet = Me.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.
            Return 0.5  ' c'est un cercle... tous les points sont au milieu!
            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>
    ''' Calcule et retourne la valeur de T à un certain endroit
    ''' </summary>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <param name="z"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetT(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
        Dim retval As Object
        Dim retour(1) As Double
        retval = Me.SwArete.GetParameter(x, y, z)
        retour = retval
        If Not retour(1) Then
            Me.Colorer(2, 1, 0.5, 0) ' : Commun.MettreUnPoint(x, y, z)
            Dim ret As Object = Me.swArete.GetClosestPointOn(x, y, z)

            Dim obj As Object = Me.swArete.GetClosestPointOn(x, y, z)
            Dim ob() As Double = obj
            retval = Me.swArete.GetParameter(ob(0), ob(1), ob(2))

        End If
        Return retour(0)
    End Function

    ''' <summary>
    ''' Fonction qui retourne le Tmin de l'arète
    ''' </summary>
    ''' <returns>Tmax</returns>
    ''' <remarks></remarks>
    Public Function GetTMin() As Double
        Dim vp As Object
        swArete.GetCurve()
        vp = swArete.GetCurveParams2()
        Return vp(6)
    End Function


    ''' <summary>
    ''' Fonction qui retourne le Tmax de l'arète
    ''' </summary>
    ''' <returns>Tmax</returns>
    ''' <remarks></remarks>
    Public Function GetTMax() As Double
        Dim vp As Object
        swArete.GetCurve()
        vp = swArete.GetCurveParams2()
        Return vp(7)
    End Function


    ''' <summary>
    ''' Détermine si la valeur de T est sur la courbe, si oui ça retourne les coordonnées XYZ
    ''' </summary>
    ''' <param name="T"></param>
    ''' <param name="xyz"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Evaluer(ByRef T As Double, Optional ByRef xyz() As Double = Nothing) As Boolean

        Dim temp(2) As Double
        Dim retval As Object
        Dim retour() As Double
        Dim T1 As Double
        Dim T2 As Double

        retval = Me.SwArete.GetCurveParams2()
        retour = retval
        T1 = retour(6)
        T2 = retour(7)

        If Not ((T >= T1) And (T <= T2)) Then Return False

        retval = Me.SwArete.Evaluate(T)

        temp(0) = retval(0)
        temp(1) = retval(1)
        temp(2) = retval(2)

        xyz = temp

        Return True

    End Function


    ''' <summary>
    ''' Détermine si la valeur de T est sur la courbe, si oui ça retourne les coordonnées XYZ
    ''' </summary>
    ''' <param name="T"></param>
    ''' <param name="x"></param>
    ''' <param name="y"></param>
    ''' <param name="z"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Evaluer(ByRef T As Double, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
        'si XYZ est omis alors on veut juste savoir si le paramètre est sur la courbe

        Dim temp(2) As Double
        Dim retval As Object
        Dim retour() As Double
        Dim T1 As Double
        Dim T2 As Double

        retval = Me.SwArete.GetCurveParams2()
        retour = retval
        T1 = retour(6)
        T2 = retour(7)

        If Not ((T >= T1) And (T <= T2)) Then Return False

        retval = Me.SwArete.Evaluate(T)

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

        Return True
    End Function

    ''' <summary>
    ''' Fonction qui compare la superarete avec une autre arète de solidworks
    ''' </summary>
    ''' <param name="swArete"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function comparer(ByRef swArete As SldWorks.Edge) As Boolean
        Dim e As New SuperArete(swArete, True)
        Return comparer(e)
    End Function


    ''' <summary>
    ''' Fonction qui compare 2 superaretes.  Retourne vrai si les 2 arêtes sont identiques
    ''' </summary>
    ''' <param name="sAreteTest">L'arète avec laquelle comparer</param>
    ''' <returns>Vrais si les 2 arêtes peuvent être fusionnées.  Faux sinon</returns>
    ''' <remarks></remarks>
    Public Function Comparer(ByRef sAreteTest As SuperArete) As Boolean
        'on a 2 arètes, et on ne peut comparer directement les pointeurs...

        If swArete Is sAreteTest Then Return True


        ' 2 - les 2 points d'extrémités sont identiques.
        Dim debut1() As Double = Me.GetStartPoint
        Dim debut2() As Double = sAreteTest.GetStartPoint
        Dim fin1() As Double = Me.GetEndPoint
        Dim fin2() As Double = sAreteTest.GetEndPoint

        If debut1 Is Nothing Xor debut2 Is Nothing Then Return False
        If debut1 Is Nothing And debut2 Is Nothing Then ' peut-être un cercle
            If Not swModel.ClosestDistance(sAreteTest.swArete, Me.swArete, Nothing, Nothing) < Epsilon Then Return False
            ' bon, on a 2 cercles (ou courbe fermées) qui se touchent à au moins un point...
            Dim courbe1 As sldworks.Curve = Me.swArete.GetCurve
            Dim courbe2 As sldworks.Curve = sAreteTest.swCourbe

            If Me.IsCircle AndAlso sAreteTest.IsCircle Then
                Dim vparam1 As Object = courbe1.CircleParams()
                Dim vparam2 As Object = courbe2.CircleParams()
                If Math.Abs(vparam1(0) - vparam2(0)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(1) - vparam2(1)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(2) - vparam2(2)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(6) - vparam2(6)) < 1000 * Epsilon Then
                    Dim tmilieuC As Double = Me.GetTMilieu
                    Dim xyzC() As Double = Nothing
                    If Not Me.Evaluer(tmilieuC, xyzC) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut....
                    Dim vPointC As Object = sAreteTest.swArete.GetClosestPointOn(xyzC(0), xyzC(1), xyzC(2))
                    If Distance(xyzC(0), xyzC(1), xyzC(2), vPointC(0), vPointC(1), vPointC(2)) < 0.000001 Then Return True Else Return False
                Else
                    Return False
                End If

            ElseIf Me.IsEllipse AndAlso sAreteTest.IsEllipse Then
                Dim vparam1 As Object = courbe1.GetEllipseParams()
                Dim vparam2 As Object = courbe2.GetEllipseParams()
                For i As Integer = 0 To 10
                    If Math.Abs(vparam1(i) - vparam2(i)) > 1000 * Epsilon Then Return False
                Next
                Return True
            Else ' peut-être des splines fermées...
                ' on fait un test sur ... ? 20 points ? ... sur une des 2 courbes, et si le point appartient à l'autre courbe aussi on retourne true
                ' la courbe Originale est me.swArete
                Dim g As Integer = 0
                Dim pointTest(2) As Double
                Dim Tmin As Double = Me.GetTMin
                Dim Tmax As Double = Me.GetTMax
                Dim incrT As Double = (Tmax - Tmin) / 20


                While g < 20
                    Me.Evaluer(Tmin + g * incrT, pointTest)
                    If Commun.Distance(sAreteTest.swArete, pointTest) > 0.000001 Then Return False ' merde, je déteste cette façon de procéder!
                    g += 1
                End While


                Return True
            End If
            End If

        If Distance(debut1, debut2) > 1000 * Epsilon AndAlso Distance(debut1, fin2) > 1000 * Epsilon Then Return False
        If Distance(fin1, debut2) > 1000 * Epsilon AndAlso Distance(fin1, fin2) > 1000 * Epsilon Then Return False

        ' update, le point milieu ne marche pas toujours.., mais si on a une ligne, innutile de tester plus loin
        If Me.IsLine And sAreteTest.IsLine Then Return True


        'Dim D1() As Double = Me.GetTangenceDepart()
        'Dim A1() As Double = Me.GetTangenceArivee()

        'Dim D2() As Double = sAreteTest.GetTangenceDepart
        'Dim A2() As Double = sAreteTest.GetTangenceArivee


        'If Distance(debut1, debut2) < 1000 * Epsilon Then ' courbes dans même sens

        '    If Outils_Math.ComparerVecteurs3D(D1, D2) AndAlso Outils_Math.ComparerVecteurs3D(A1, A2) Then Return True Else Return False
        'Else ' courbes dans sens différent
        '    Dim P1(2) As Double
        '    Dim P2(2) As Double
        '    If Outils_Math.ComparerVecteurs3D(D1, A2) = 1 AndAlso Outils_Math.ComparerVecteurs3D(A1, D2) = 1 Then Return True Else Return False
        'End If


        ' une autre stratégie
        Dim tmilieu As Double = Me.GetTMilieu
        Dim xyz() As Double = Nothing
        If Not Me.Evaluer(tmilieu, xyz) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut....
        Dim vPoint As Object = sAreteTest.swArete.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
        If Distance(xyz(0), xyz(1), xyz(2), vPoint(0), vPoint(1), vPoint(2)) < 0.000001 Then Return True Else Return False


    End Function


    ''' <summary>
    ''' DOnne la longueur d'une arète
    ''' </summary>
    ''' <value></value>
    ''' <returns>La longueur de l'arète</returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Longueur() As Double
        Get
            Dim temp As Object
            Dim T1 As Double, T2 As Double
            Dim sommet As sldworks.Vertex
            Dim point As Object

            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(6) * 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." & vbCr & "  On pourrait prendre la tessellation, mais là on aurait une approximation!")
            End If
        End Get
    End Property

    ''' <summary>
    ''' Si la courbe est un cercle, retourne le rayon.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property Rayon() As Double
        Get
            'MsgBox("Mettre du code ici")
            Dim swCurve As sldworks.Curve = Me.swArete.GetCurve


            If Me.IsCircle Then
                Dim obj As Object = swCurve.CircleParams()
                Return obj(6)
            Else : Return (Nothing)
            End If

        End Get
    End Property


    ''' <summary>
    '''  Renvoie les coordonnées du point de départ
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function GetStartPoint() As Double()
        Dim swSommet As sldworks.Vertex
        Dim retval As Object
        Dim xyz(2) As Double
        swSommet = Me.swArete.GetStartVertex()
        If swSommet Is Nothing Then Return Nothing
        retval = swSommet.GetPoint()
        xyz = retval
        Return xyz
    End Function

    ''' <summary>
    '''  Renvoie les coordonnées du point de départ
    ''' </summary>
    ''' <returns>Faux si le sommet n'esiste pas</returns>
    ''' <remarks></remarks>
    Public Function GetStartPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
        Dim swSommet As sldworks.Vertex
        Dim retval As Object
        Dim xyz(2) As Double
        swSommet = Me.swArete.GetStartVertex()
        If swSommet Is Nothing Then Return False
        retval = swSommet.GetPoint()
        x = retval(0)
        y = retval(1)
        z = retval(2)
        Return True
    End Function

    Public Function GetEndPoint() As Double()
        Dim swSommet As sldworks.Vertex
        Dim retval As Object
        Dim xyz(2) As Double
        swSommet = Me.swArete.GetEndVertex()
        If swSommet Is Nothing Then Return Nothing
        retval = swSommet.GetPoint()
        xyz = retval
        Return xyz
    End Function

    ''' <summary>
    '''  Renvoie les coordonnées du point de fin
    ''' </summary>
    ''' <returns>Faux si le sommet n'esiste pas</returns>
    ''' <remarks></remarks>
    Public Function GetEndPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
        Dim swSommet As sldworks.Vertex
        Dim retval As Object
        Dim xyz(2) As Double
        swSommet = Me.swArete.GetEndVertex()
        If swSommet Is Nothing Then Return False
        retval = swSommet.GetPoint()
        x = retval(0)
        y = retval(1)
        z = retval(2)
        Return True
    End Function


    ''' <summary>
    ''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de départ de la courbe
    ''' </summary>
    ''' <returns>La tangence de la courbe</returns>
    ''' <remarks></remarks>
    Public Function GetTangenceDepart() As Double()
        Dim s1 As sldworks.Vertex = Me.SommetDebut
        Dim es1 As New SuperSommet(s1, True)
        Dim T As Double = Me.GetTMin

        Dim tan(2) As Double
        Me.Evaluer(T + 100 * Epsilon, tan)
        tan(0) = es1.X - tan(0)
        tan(1) = es1.Y - tan(1)
        tan(2) = es1.Z - tan(2)

        Return Outils_Math.unitaire(tan)

        'Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve
        'Dim vTangent As Object = swCourbe.Evaluate(Me.GetTMin)
        ''[ PointX, PointY, PointZ, TangentX, TangentY, TangentZ, Success ]
        'Dim dTangent(2) As Double
        'dTangent(0) = vTangent(3) : dTangent(1) = vTangent(4) : dTangent(2) = vTangent(5)
        'Return dTangent
    End Function

    ''' <summary>
    ''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe
    ''' </summary>
    ''' <returns>La tangence de la courbe</returns>
    ''' <remarks></remarks>
    Public Function GetTangenceArivee() As Double()
        Dim s1 As sldworks.Vertex = Me.SommetFinal
        Dim es1 As New SuperSommet(s1, True)
        Dim T As Double = Me.GetTMax

        Dim tan(2) As Double
        Me.Evaluer(T - 100 * Epsilon, tan)
        tan(0) = es1.X - tan(0)
        tan(1) = es1.Y - tan(1)
        tan(2) = es1.Z - tan(2)

        Return Outils_Math.unitaire(tan)

    End Function

    ''' <summary>
    ''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe
    ''' </summary>
    ''' <param name="T">La valuer de T à laquelle on cherche la tangence</param>
    ''' <returns>La tangence de la courbe</returns>
    ''' <remarks></remarks>
    Public Function GetTangence(ByVal T As Double) As Double()
        Dim s1 As sldworks.Vertex = Me.SommetFinal
        Dim es1 As New SuperSommet(s1, True)

        Dim tan(2) As Double
        Me.Evaluer(T, tan)
        tan(0) = es1.X - tan(0)
        tan(1) = es1.Y - tan(1)
        tan(2) = es1.Z - tan(2)

        Return Outils_Math.unitaire(tan)

    End Function


    ''' <summary>
    ''' Retourne le premier sommet de la courbe
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property SommetDebut() As sldworks.Vertex
        Get
            Return Me.swArete.GetStartVertex
        End Get
    End Property

    ''' <summary>
    ''' Retourne le dernier sommet de la courbe
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly Property SommetFinal() As sldworks.Vertex
        Get
            Return Me.swArete.GetEndVertex
        End Get
    End Property


    ''' <summary>
    ''' Sub utilisée pour le débuggage qui met 100 points sur la courbe
    ''' </summary>
    ''' <remarks>POur évaluer la tolérance</remarks>
    Public Sub RemplirDePoints()
        Dim T As Double, Tmin As Double, Tmax As Double, Tinc As Double
        Dim P(2) As Double
        swModel.Insert3DSketch2(False)

        Tmin = Me.GetTMin
        Tmax = Me.GetTMax
        Tinc = (Tmax - Tmin) / 100
        T = Tmin

        For i As Integer = 0 To 100
            T += Tinc
            Me.Evaluer(T, P)
            swModel.CreatePoint2(P(0), P(1), P(2))
        Next i

        swModel.Insert3DSketch2(False)
    End Sub


    ''' <summary>
    ''' Sélectionne l'arète, mais s'assure de ne pas la désélectionner si elle est déjà sélectionnée
    ''' </summary>
    ''' <remarks>Pas très rapide...</remarks>
    Public Sub SelectionnerSafe()
        Dim swEnt As sldworks.Entity = Me.swArete
        Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager

        For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1)
            If selMgr.GetSelectedObject6(i, -1) Is swEnt Then
                Exit Sub
            End If
        Next

        swEnt.Select4(True, Nothing)
    End Sub


    Public Sub PasserLes2FacesAdjascentes(ByRef swFace1 As sldworks.Face2, ByRef swFace2 As sldworks.Face2)
        Dim obj As Object = Me.swArete.GetTwoAdjacentFaces2()
        swFace1 = obj(0)
        swFace2 = obj(1)
    End Sub

End Class
Revision:	205
Committed:	Thu Jul 23 20:53:57 2009 UTC (15 years, 9 months ago) by bournival
File size:	37658 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