REPOS_ERICCA/magicsld/SlyFaceCoque.vb

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

Public Class SlyFaceCoque
    Inherits SuperFace


    Private epaisseur As Double
    Public materiau As Long
    Public swAttribute As SldWorks.Attribute  ' l'attribut qui contient l'épaisseur. et le matériau

    Private FlagFace_de_section As Integer = 99

    Sub New(ByRef swface As SldWorks.Face2)
        MyBase.New(swface, 1) ' 1 car c'est une coque
    End Sub

    Protected Overrides Sub Finalize()
        Me.lst_Faces.Clear()
        Me.lst_InterPoutre.Clear()
        Me.lst_InterCoqueVolume.Clear()
        MyBase.Finalize()
    End Sub


    Public Overrides Sub decouper()

        If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection


        ' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
        ' on mémorise l'attribut de la face et on la réapplique à la fin.


        Dim i As Integer
        Dim inter As InterPoutreCoque
        Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
        Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
        Dim lst_poutre2 As New Collection
        Dim aire As Double
        Dim poutreTest As SlyAretePoutre

        Dim lst_coupeXinter As New Collection
        Dim lst_coupeXPoutre As New Collection
        Dim lst_coupeLinter As New Collections.Generic.List(Of InterPoutreCoque)
        Dim lst_coupeLPoutre As New Collection
        Dim lst_coupeCinter As New Collection
        Dim lst_coupeCPoutre As New Collection


        For Each inter In lst_InterPoutre
            'MsgBox("On découpe l'intersection # " & inter.Numero)
            'pour chaque intersection on peut avoir plusieurs poutres...
            For i = 1 To inter.lst_sPoutre.Count
                poutreTest = inter.lst_sPoutre.Item(i)
                Select Case CInt(inter.lst_type.Item(i))
                    Case 1
                        If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
                        nb1 += 1
                    Case 2
                        lst_poutre2.Add(poutreTest)
                        nb2 += 1
                    Case 3
                        If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
                        nb3 += 1
                    Case 5 ' un poutre à faceDeSection
                        nb5 += 1
                    Case 6
                        MsgBox("Une extrémité de la poutre est avec un «Guide» alors que l'autre coté ne l'est pas.  Ceci n'est pas programmé...")

                    Case 22
                        ' on fait rien, mais c'est pour éviter le msgbox du case else...
                    Case Else
                        MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
                End Select
            Next i


            If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
                lst_coupeXinter.Add(inter)
                lst_coupeXPoutre.Add(poutre1)
            End If


            For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
                lst_coupeLinter.Add(inter)
                lst_coupeLPoutre.Add(poutreTest)
            Next

            If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
                lst_coupeCinter.Add(inter)
                lst_coupeCPoutre.Add(poutre3)
            End If

            If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
                MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
            End If


            lst_poutre2.Clear()
            nb1 = 0 : nb2 = 0 : nb3 = 0


        Next inter


        ' maintenant on a toutes les lists d'intersections.  On les coupe.
        For i = 1 To lst_coupeXinter.Count
            CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
        Next

        For Each int As InterPoutreCoque In lst_coupeLinter '  i = 1 To lst_coupeLinter.Count
            int.DecouperLong()                               'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
        Next

        For i = 1 To lst_coupeCinter.Count
            CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
        Next

        ' ne devrait pas avoir ça avec une coque...
        'If nb5 = 1 Then
        '    If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
        '    CoupeFaceDeSection(lst_InterPoutre(1))
        'End If

    End Sub


    ' sub qui découpe les bords de la face.
    Friend Sub CoupeCote(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
        Dim pt3() As Double, pt3Original() As Double
        Dim base(2) As Double, baseOriginal(2) As Double
        Dim swEnt As sldworks.Entity
        Dim Directionnel As Boolean, Flip As Boolean
        Dim planReference As sldworks.RefPlane = Nothing
        Dim sketchline As sldworks.SketchSegment
        Dim swSketch As sldworks.Sketch
        Dim DemiLargeur As Double
        Dim g As Integer
        Dim Face(1) As sldworks.Face2
        Dim PlanEntity As sldworks.Entity = Nothing
        Dim r(2) As Double
        Dim sk(1) As Double
        pt3Original = poutre.GetPoint3


        swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
        'swModel.SetAddToDB(True)
        'swModel.SetDisplayWhenAdded(False) ' accélérer les performances

        Dim vArete As Object
        Dim cut As Double

        If Me.estPlan Then
            ' la coque est plane, on met une esquisse dessus.#
            PlanEntity = Me.SwFace
            swEnt = PlanEntity
            swEnt.Select2(False, 0)
            planReference = swModel.CreatePlaneAtOffset3(0, False, True)

        ElseIf Me.estCylindre Then
            ' on doit créer un plan de référence...

        ElseIf Me.estFauxPlan(inter.x, inter.y, inter.z) Then
            Dim vEdge As Object
            Dim i As Integer
            Dim swArete2() As sldworks.Edge
            Dim swSommet As sldworks.Vertex

            vEdge = Me.SwFace.GetEdges
            swArete2 = vEdge
            swModel.ClearSelection2(True)

            While planReference Is Nothing
                If UBound(swArete2) - 2 < i Then MsgBox("Dans CoupeLong, problème pour créer un plan avec 3 points.  (La face est un FauxPlan)", MsgBoxStyle.Critical, "Le plan ne sera pas créé") : Exit While
                swSommet = swArete2(i).GetStartVertex()
                swEnt = swSommet
                swEnt.Select4(False, Nothing)
                swArete2(i + 1).GetStartVertex()
                swEnt = swSommet
                swEnt.Select4(True, Nothing)
                swArete2(i + 2).GetStartVertex()
                swEnt = swSommet
                swEnt.Select4(True, Nothing)
                i += 1
                planReference = swModel.CreatePlaneThru3Points3(False)
                PlanEntity = planReference
            End While


        Else ' la face est une spline
            MsgBox("Dans coupeCoté, la face est un type de surface qui n'est pas encore traité")
        End If


        baseOriginal(0) = inter.x : baseOriginal(1) = inter.y : baseOriginal(2) = inter.z


        Dim Psi As Double
        Dim u(2) As Double, v(2) As Double, usketch(2) As Double, vsketch(2) As Double
        Dim Arete As sldworks.Edge = Nothing
        Dim retval As Object
        u = poutre.GetOrientation(inter.x, inter.y, inter.z)


        vArete = Me.SwFace.GetEdges

        For Each Arete In vArete
            If Commun.Distance(Arete, inter.x, inter.y, inter.z) < Epsilon Then Exit For
        Next

        retval = Arete.GetClosestPointOn(inter.x, inter.y, inter.z)
        Dim t As Double = retval(3)
        retval = Arete.Evaluate(t)

        If t > 0 Then  ' ??????? solidworks inverse les valeurs dans des cas que je ne peut identifier.
            v(0) = retval(3) : v(1) = retval(4) : v(2) = retval(5)
        Else
            v(0) = retval(4) : v(1) = -retval(3) : v(2) = retval(5)
        End If


        For g = 0 To 1

            PlanEntity.Select(False)
            swModel.InsertSketch2(True)
            swSketch = swModel.GetActiveSketch2

            pt3 = Commun.TransfertModelSketch(swSketch, pt3Original)
            usketch = Commun.TransfertModelSketch(swSketch, u)  ' on les met dans le plan du sketch
            vsketch = Commun.TransfertModelSketch(swSketch, v)
            base = Commun.TransfertModelSketch(swSketch, baseOriginal)
            Psi = Outils_Math.cosdir(usketch, vsketch)

            Dim a As Double, b As Double
            'longueur = Math.Sqrt(pt3(0) * pt3(0) + pt3(1) * pt3(1))
            'If pt3(1) = 0 Then a = 999999999999 Else a = Math.Abs(poutre.GetD2() * longueur / pt3(1))
            'If pt3(0) = 0 Then b = 999999999999 Else b = Math.Abs(poutre.GetD1() * longueur / pt3(0))
            ' À revoir. Si le plan est un cylindre ça marche plus. sans compter l'épaisseur de la poutre.
            ' pour l'instant je prend la plus prtite valeur...
            a = poutre.GetD1
            b = poutre.GetD2
            DemiLargeur = Math.Min(a, b)
            cut = DemiLargeur / Math.Sin(Pi / 2 - Psi)


            Dim P1(1) As Double
            Dim P2(1) As Double
            Dim P3(1) As Double
            Dim P4(1) As Double
            Dim Ptest(2) As Double
            Dim Ptest2(2) As Double : Ptest2(0) = 0.5 : Ptest2(1) = 0
            Dim Ptest3(2) As Double : Ptest3(0) = 0 : Ptest3(1) = 0.75
            Dim Ptest4(2) As Double : Ptest4(0) = 1.5 : Ptest4(1) = 0
            Dim Ptest5(2) As Double : Ptest5(0) = 0 : Ptest5(1) = 2


            If g = 0 Then
                P1(0) = -cut
                P1(1) = -cut '* mult ' 0
                P2(0) = 0
                P2(1) = -cut '* mult ' 0
                P3(0) = 0
                P3(1) = cut   'Intersections.Taille mult
                P4(0) = -cut
                P4(1) = cut   'Intersections.Taille mult
                'sk(0) = -Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
                sk(0) = -Epsilon * 100 : sk(1) = 0

            Else
                P1(0) = 0
                P1(1) = -cut '* mult '0
                P2(0) = +cut
                P2(1) = -cut '* mult '0
                P3(0) = +cut
                P3(1) = cut  'Intersections.Taille mult
                P4(0) = 0
                P4(1) = cut  'Intersections.Taille mult
                'sk(0) = Epsilon * 100 + base(0) : sk(1) = 0 + base(1)
                sk(0) = Epsilon * 100 : sk(1) = 0
            End If

            P1 = Outils_Math.Rotation2D(vsketch, P1)
            P2 = Outils_Math.Rotation2D(vsketch, P2)
            P3 = Outils_Math.Rotation2D(vsketch, P3)
            P4 = Outils_Math.Rotation2D(vsketch, P4)
            sk = Outils_Math.Rotation2D(vsketch, sk)
            Ptest4 = Outils_Math.Rotation2D(vsketch, Ptest4)
            Ptest5 = Outils_Math.Rotation2D(vsketch, Ptest5)

            sk(0) += base(0)
            sk(1) += base(1)

            Ptest(0) += base(0)
            Ptest(1) += base(1)

            swModel.CreatePoint2(Ptest(0), Ptest(1), 0)

            sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest2(0) + base(0), Ptest2(1) + base(1), 0) : sketchline.ConstructionGeometry = True
            sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest3(0) + base(0), Ptest3(1) + base(1), 0) : sketchline.ConstructionGeometry = True
            sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest4(0) + base(0), Ptest4(1) + base(1), 0) : sketchline.ConstructionGeometry = True
            sketchline = swModel.CreateLine2(base(0), base(1), 0, Ptest5(0) + base(0), Ptest5(1) + base(1), 0) : sketchline.ConstructionGeometry = True
            sketchline = swModel.CreateLine2(base(0), base(1), 0, vsketch(0) + base(0), vsketch(1) + base(1), 0) : sketchline.ConstructionGeometry = True

            sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P2(0) + base(0), P2(1) + base(1), 0)
            sketchline = swModel.CreateLine2(P2(0) + base(0), P2(1) + base(1), 0, P3(0) + base(0), P3(1) + base(1), 0)
            sketchline = swModel.CreateLine2(P3(0) + base(0), P3(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)
            sketchline = swModel.CreateLine2(P1(0) + base(0), P1(1) + base(1), 0, P4(0) + base(0), P4(1) + base(1), 0)


            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
            swModel.ClearSelection2(True)
            'swEnt = Me.SwFace : swEnt.Select2(False, 1)
            swEnt = swSketch : swEnt.Select2(False, 4)
            Me.SelectionnerToutes(1, True)

            swModel.InsertSplitLineProject(Directionnel, Flip)
            r = Commun.TransfertSketchToModel(swSketch, sk)
            Face(g) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, , False)
            'If Face(g) Is Nothing Then
            'swSketch.Select(False)
            'swModel.EditDelete()
            'End If


        Next g


        ' mettre les mini-poutres
        Dim vEdge2 As Object
        Dim swArete As sldworks.Edge
        Dim vPoint As Object
        Dim Mini1 As sldworks.Edge = Nothing, Mini2 As sldworks.Edge = Nothing


        ' 1 - trouver les 2 arrères dont l'orientation est la même (ou l'inverse) que le v
        For g = 0 To 1
            If Not Face(g) Is Nothing Then
                vEdge2 = Face(g).GetEdges()


                ' construire u
                For Each swArete In vEdge2
                    If Commun.Distance(swArete, inter.x, inter.y, inter.z) < Epsilon Then
                        ' l'arête touche à l'intersection, 
                        vPoint = swArete.GetClosestPointOn(inter.x, inter.y, inter.z)
                        vPoint = swArete.Evaluate(vPoint(3))
                        u(0) = vPoint(3) : u(1) = vPoint(4) : u(2) = vPoint(5)

                        If Outils_Math.CompareSens(v, u) Then
                            ' l'arète doit être une mini-poutre
                            If Mini1 Is Nothing Then Mini1 = swArete : Exit For Else Mini2 = swArete : Exit For
                        End If
                    End If

                Next

            End If
        Next

        swEnt = Mini1
        If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")

        If Not Mini2 Is Nothing Then
            swEnt = Mini2
            If Not RealConstant.RCCode.CreationAttributPourPoutre(swEnt, "Mini", True) Then MsgBox("A pas marché!")
        End If

        swModel.SetInferenceMode(True) '
        'swModel.SetAddToDB(False)
        'swModel.SetDisplayWhenAdded(True) ' 
    End Sub


    ''' <summary>
    ''' sub qui CRÉÉ une instance de la classe InterPoutreCoque si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.  
    ''' </summary>
    ''' <param name="sPoutre">La SlyPoutre</param>
    ''' <param name="xyz1">Laposition du pount d'intersection</param>
    ''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
    ''' <returns>La classe d'intersection</returns>
    ''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
    Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreCoque

        Dim int As InterPoutreCoque

        For Each int In lst_InterPoutre
            If Math.Abs(int.x - xyz1(0)) < Epsilon And Math.Abs(int.y - xyz1(1)) < Epsilon And Math.Abs(int.z - xyz1(2)) < Epsilon Then
                ' on a un point déjà existant,
                int.lst_sPoutre.Add(sPoutre)
                int.lst_type.Add(tipe)
                Return int
            End If
        Next


        ' si on est ici c'est que l'on doit créer l'intersection
        int = New InterPoutreCoque

        int.x = xyz1(0)
        int.y = xyz1(1)
        int.z = xyz1(2)

        int.lst_sPoutre.Add(sPoutre)
        int.lst_type.Add(tipe)
        int.sFaceCoque = Me
        lst_InterPoutre.Add(int)
        Return int

    End Function


    Public Function PossedeFaceDeSection() As Boolean

        If Not Me.FlagFace_de_section = 99 Then Return CBool(Me.FlagFace_de_section)
        Dim retour As Double

        Dim p As SldWorks.Parameter
        Try
            p = swAttribute.GetParameter("Flag")
        Catch ex As Exception
            MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaissuer, la coque n'a peut-être pas d'attributs...")
            Return Nothing
        End Try

        retour = p.GetDoubleValue
        Me.FlagFace_de_section = retour
        If retour = 1 Then Return True Else Return False

    End Function


    ''' <summary>
    ''' Donne l'épaisseur de la coque
    ''' </summary>
    ''' <value>La valeur de l'épaisseur ATTENTION: voir remarques</value>
    ''' <returns>L'épaisseur de la coque</returns>
    ''' <remarks>La propriété ne peut être un readonly à cause d'une petite exception, normalement on ne devrait pas setter l'épaisseur de la coque</remarks>
    Public Property GetEpaisseur() As Double
        Get

            If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Property ' pour optimiser

            Dim p As sldworks.Parameter

            Try
                p = swAttribute.GetParameter("Ep")
            Catch ex As Exception
                MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
                Return 0
            End Try
            Me.epaisseur = p.GetDoubleValue
            Return p.GetDoubleValue

        End Get

        Set(ByVal value As Double)
            Me.epaisseur = value
            ' faut aussi changer le paramètre de l'attribut
            Dim p As sldworks.Parameter = Me.swAttribute.GetParameter("Ep")
            p.SetDoubleValue(Me.epaisseur)
        End Set
    End Property


    Public Function GetMateriau() As String
        If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser


        Dim p As SldWorks.Parameter = Nothing

        Try
            p = swAttribute.GetParameter("M")
        Catch ex As Exception
            MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
        End Try
        Me.materiau = p.GetStringValue
        Return p.GetStringValue
    End Function

    Public Function GetAttribute() As SldWorks.Attribute
        Dim ent As SldWorks.Entity
        Dim attr As SldWorks.Attribute = Nothing

        Try
            ent = lst_Faces.Item(1)
            attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
            Me.swAttribute = attr
        Catch ex As Exception
            MsgBox("ERREUR!   Une coque sans attributs !", MsgBoxStyle.Critical)
        End Try
        If IsNothing(attr) Then  ' on a trouvé un attribut de coque
            MsgBox("Une coque sans attributs !")
        End If
        Return attr
    End Function

    Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
        Dim b(1) As Double
        Dim c(1) As Double
        Dim d(1) As Double
        b(0) = P1(0) - centreX
        b(1) = P1(1) - centreY
        c(0) = P1(0) - centreX
        c(1) = P1(1) - centreY

        b = Outils_Math.unitaire(b)
        c = Outils_Math.unitaire(c)

        d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
        d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon

        Return d

    End Function

    ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
    Public Sub AddConstantes()
        ' cette sub ajoute LES constantes de la coque aux nom de l'entité.
        ' on suppose qu'il n'y en a pas déjà
        ' tout ce que j'ai à faire c'est de modifier la propriété nom.

        'Format(valeur, "0.00000e+000")
        Dim epaisseur As Double


        epaisseur = Me.GetEpaisseur()
        If epaisseur <= 0 Then
            MsgBox("Attention, une coque n'a pas d'épaisseur ou une épaisseur négative, celle-ci est affichée en rouge sur le modèle découpé.  Une valeur de 1 a été utilisée par défaut")
            epaisseur = 1
            Dim ent As SldWorks.Entity
            ent = Me.swFace : ent.Select4(False, Nothing)
            swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
        End If


        nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")

        ' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
        Dim c As Integer
        For c = 1 To Len(nom)
            If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
        Next c
    End Sub


    Protected Function UpdateApresSplit(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre, ByRef x As Double, ByRef y As Double, ByRef z As Double, ByRef Plan As sldworks.RefPlane, Optional ByRef FI As Boolean = False, Optional ByVal ajouterMini As Boolean = False) As sldworks.Face2

        ' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée  
        ' cette procédure doit créer une nouvelle SlyFaceCoque 
        ' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
        ' la fonction ne créée pas de nouvelles slyEntités.
        ' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces


        ' 1 - on obtient les 2 nouvelles faces,
        Dim vFace As Object
        Dim Face As sldworks.Face2 = Nothing
        Dim FaceInterne As sldworks.Face2
        Dim swFeat As sldworks.Feature
        Dim swent As sldworks.Entity = Nothing
        Dim swFaultEnt As sldworks.FaultEntity

        swFeat = swModel.FeatureByPositionReverse(0)
        Try
            vFace = swFeat.GetFaces
            For Each Face In vFace
                Me.lst_Faces.Add(Face)
            Next Face
        Catch
            ' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
            ' on doit donc le déterminer anyway
        End Try


        For Each Face In Me.lst_Faces  ' à revoir
            swFaultEnt = Face.Check
            If Not IsNothing(swFaultEnt) Then
                Me.lst_Faces.GetEnumerator()
            End If
        Next Face


        ' on créé un point dans un sketch et on le place 
        ' This method projects the selected sketch items from the current sketch on a selected surface.
        ' en fait ça projette juste une courbe...  
        ' et si ça retourne nul alors la projection a pas marchée.
        Dim swSKSeg As sldworks.SketchSegment
        swSKSeg = Commun.MettreUneLigne(Plan, x - 20 * Epsilon, y - 20 * Epsilon, z, x + 20 * Epsilon, y + 20 * Epsilon, z)

        swFeat = Nothing
        For Each Face In Me.lst_Faces
            swSKSeg.Select4(False, Nothing)
            swent = Face : swent.Select4(True, Nothing)
            swFeat = swModel.InsertProjectedSketch2(0) ' 1 pour inverser la direction de la projection
            If swFeat IsNot Nothing Then Exit For
            swFeat = swModel.InsertProjectedSketch2(1) ' 1 pour inverser la direction de la projection
            If swFeat IsNot Nothing Then Exit For
        Next Face


        If swFeat Is Nothing Then
            ' on passe à un autre type d'essai...
            Dim dist As Double
            For Each Face In Me.lst_Faces
                dist = swModel.ClosestDistance(Face, swSKSeg, Nothing, Nothing)
                If Math.Abs(dist) < Epsilon Then FaceInterne = Face : Exit For
            Next Face


            If FaceInterne Is Nothing Then MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
            Return Nothing


        Else
            FaceInterne = Face
            ' effacer le feature...
        End If


        ' ************************************************
        ' pour placer un attribut sur la face interne
        Static no As Integer

        If FI Then no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
        If ajouterMini Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)


        'If FI Then
        '    Dim nom2 As String = "FaceInterne" & no

        '    swent = FaceInterne
        '    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, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig

        '    While attr Is Nothing
        '        no += 1
        '        nom2 = "FaceInterne" & CStr(no)
        '        attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
        '    End While
        '    GererDossiers("FaceInternes", nom2)
        '    no += 1
        'ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
        '    Dim nom2 As String = "FaceInterne" & no

        '    swent = FaceInterne
        '    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, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig

        '    While attr Is Nothing
        '        no += 1
        '        nom2 = "FaceInterne" & CStr(no)
        '        attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
        '    End While
        '    GererDossiers("FaceInternes", nom2)
        '    no += 1
        '    MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
        'Else
        '    If Not VientDeCoupecote Then MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
        'End If

        '  ************ l'attribut de la condition aux limites *******************
        Dim attr As sldworks.Attribute
        attr = Nothing
        Dim nom3 As String
        Dim p As sldworks.Parameter
        If Not Me.condition = "" Then
            nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
            attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.

            While attr Is Nothing
                If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
                If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
            End While

            p = attr.GetParameter("CL")
            p.SetStringValue(Me.condition)

        End If
        GererDossiers("Conditions Aux Limites", nom3)
        ' *****************************************************
        Return FaceInterne


    End Function

    Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
        Dim nom As String
        Dim swFace As SldWorks.Face2
        Dim swent As SldWorks.Entity
        Dim no As Long
        Dim Attr As SldWorks.Attribute

        swFace = Me.SwFace
        swent = swFace


        Try
            Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
        Catch ex As Exception
            'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
            Exit Sub
        End Try

        If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig

        While Attr Is Nothing
            no += 1
            nom = "RCCoque" & CStr(no)
            Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
            If no > 100000 Then MsgBox("N'arrive pas à créer l'attribut sur la coque après 100 000 essais...", MsgBoxStyle.Exclamation, "Problème dans CreationAttributPourPoutre")

        End While


        Dim ParamM As SldWorks.Parameter
        Dim ParamEp As SldWorks.Parameter

        ParamM = Attr.GetParameter("M")
        ParamEp = Attr.GetParameter("Ep")

        If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
        ParamEp.SetStringValue2(epaisseur, 2, "")

    End Sub


    Protected Sub CoupeX(ByRef inter As InterPoutreCoque, ByRef poutre As SlyAretePoutre)
        Dim swEnt As sldworks.Entity = Nothing
        Dim Directionnel As Boolean, Flip As Boolean
        Dim Faces(3) As sldworks.Face2
        Dim r(2) As Double
        Dim LaSurface As sldworks.Surface
        Dim sens As Boolean
        Dim p(2) As Double
        Dim retour() As Double

        'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
        'swModel.SetAddToDB(True)
        'swModel.SetDisplayWhenAdded(False) ' accélérer les performances


        ' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
        Dim planReference As sldworks.RefPlane
        Dim swsketch As sldworks.Sketch
        Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
        Dim pointdeb(2) As Double, pointfin(2) As Double

        'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
        ' faut vraiment sélectionner le bon point...
        swSommet = poutre.swArete.GetStartVertex()
        swSommet2 = poutre.swArete.GetEndVertex()
        If swSommet Is Nothing Then
            MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité.  Ne peut pas mettre un plan si pas de sommet")
        Else
            If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
                swEnt = swSommet
            ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
                swEnt = swSommet2
            Else
                MsgBox("Dans coupeX, l'intersection n'est pas sur un sommet.  Pas encore traité.  Nécessite de créer un point au coordonnées d'intersection")
            End If
        End If

        swEnt.Select4(False, Nothing)
        swEnt = poutre.swArete
        swEnt.Select(True)

        If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
            ' si la coque est plane alors on projette le plan de référence des deux cotés, sinon on doit le décaler vers le bas
            planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
            Directionnel = False
            Flip = False
        ElseIf Me.estCylindre Then
            ' on a un cylindre, on ne projette pas des 2 cotés.  On créé un plan, puis un autre plus bas pour ensuite projeter d'un seul coté.
            Dim PlanDessus As sldworks.RefPlane
            Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
            Dim u(2) As Double, v(2) As Double
            PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
            temp1 = poutre.GetD1
            temp2 = poutre.GetD2
            L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
            Rayon = Me.GetRayonCylindre()
            u = poutre.GetOrientation(inter.x, inter.y, inter.z)
            v = Me.GetNormale(inter.x, inter.y, inter.z)
            phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
            B = Math.Abs(L / 2 * Math.Sin(phi))
            dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
            If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub

            swEnt = PlanDessus
            swEnt.Select(False)
            Directionnel = True

            Flip = Flipper(PlanDessus, inter)

            planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
        Else
            MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
            planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
            Directionnel = False
            Flip = False
        End If


        LaSurface = Me.SwFace.GetSurface()
        sens = Me.SwFace.FaceInSurfaceSense()

        ' skx est la coordonnée du point de ref en coord de sketch, Rx est le point de référence dans le repère global.
        Dim i As Integer = 0, MettreFI As Boolean
        Dim swFeat As sldworks.Feature
        Dim autresection As Boolean = True
        Dim AjouterMiniPoutre As Boolean = False

        Do While autresection = True
            i += 1
            swEnt = planReference
            swEnt.Select(False)
            swModel.InsertSketch2(False)
            swModel.ClearSelection2(True)
            swFeat = swModel.FeatureByPositionReverse(0)
            swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
            swModel.EditSketch()
            swsketch = swModel.GetActiveSketch2

            p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
            retour = Commun.TransfertModelSketch(swsketch, p)


            If SectionSimpleSurPoutre = True Then
                r = DessineSectionPoutreSimple(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, autresection, AjouterMiniPoutre)
            Else
                r = DessineSectionPoutre(poutre, retour(0), retour(1), i, swsketch, CType(inter, InterAreteFace), MettreFI, autresection, AjouterMiniPoutre)
            End If


            swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
            swModel.ClearSelection2(True)

            Dim face As sldworks.Face2
            For Each face In Me.lst_Faces
                swModel.ClearSelection2(True)
                swEnt = face : swEnt.Select2(False, 1)
                swEnt = swsketch : swEnt.Select2(True, 4)
                swModel.InsertSplitLineProject(Directionnel, Flip)
            Next


            Me.SwFace.DetachSurface()
            Me.SwFace.AttachSurface(LaSurface, sens)

            Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI, AjouterMiniPoutre)
            Commun.MettreUnPoint(r(0), r(1), r(2))

            If Faces(i) Is Nothing Then
                swEnt.Select(False)
                swModel.EditDelete()
            End If
        Loop


    End Sub


End Class

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