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


    ''' <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 la largeur, la poutre 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></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public ReadOnly 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
    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


    Friend Overrides 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) 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 Face1 As SldWorks.Face2
        Dim Face2 As SldWorks.Face2
        Dim FaceInterne As SldWorks.Face2
        Dim FaceExterne As SldWorks.Face2
        Dim swFeat As SldWorks.Feature

        swFeat = swModel.FeatureByPositionReverse(0)
        vFace = swFeat.GetFaces

        If vFace Is Nothing Then Return Nothing ' le code nothing veut dire que la face n'a pas été coupée.

        Face1 = vFace(0)
        Face2 = vFace(1)

        Try ' vérification
            Dim face3 As SldWorks.Face2
            Dim i As Integer
            'Dim slyFaceSupplémentaire As SlyFaceCoque ' la raison du pourquoi on doit avoir 2 sous-routines

            For i = 2 To 1000
                face3 = vFace(i)
                Me.lst_Faces.Add(face3)
            Next i

            'MsgBox("Problème, on a au moins 3 face dans le update après le découpage", MsgBoxStyle.Critical)
        Catch ex As Exception
            ' tout est normal...
        End Try

        ' SECRET 1.999 ' c'est pas scientifique mais ça peut marcher
        If Math.Abs(Face1.GetArea) > Math.Abs(10 * Face2.GetArea) Then
            FaceInterne = Face2
            FaceExterne = Face1
        ElseIf Math.Abs(Face1.GetArea) < Math.Abs(10 * Face2.GetArea) Then
            FaceInterne = Face1
            FaceExterne = Face2
        Else


            '' 2 - on a un point, on trouve quelle face est la plus proche.
            If Commun.Distance(Face1, x, y, z) < Commun.Distance(Face2, x, y, z) Then
                FaceInterne = Face1
                FaceExterne = Face2
            Else
                FaceInterne = Face2
                FaceExterne = Face1
            End If
        End If

        Me.lst_Faces.Add(FaceInterne)
        Me.lst_Faces.Add(FaceExterne)

        '' 3 - on créé une nouvelle coque (intérieure) et on lui donne les propriétés originales et on met dans la liste des coques
        'Me.swFace = FaceExterne
        Dim aire As Double
        aire = FaceExterne.GetArea

        ' ************************************************
        ' pour placer un attribut sur la face interne
        Dim attr As SldWorks.Attribute
        Dim swent As SldWorks.Entity
        Static no As Integer

        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
            MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
        End If

        '  ************ l'attribut de la condition aux limites *******************
        '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


End Class

Revision:	48
Committed:	Wed Aug 22 21:18:12 2007 UTC (17 years, 8 months ago) by bournival
File size:	13668 byte(s)
Log Message:	On passe aux nouveaux .dll
#	User	Rev	Content
1	bournival	48	Imports SolidWorks.Interop
2			Imports SolidWorks.Interop.swconst
3			Imports SolidWorks.Interop.swpublished
4
5	bournival	40	Public Class SlyFaceCoque
6			Inherits SuperFace
7
8
9	bournival	46	Private epaisseur As Double
10	bournival	40	Public materiau As Long
11			Public swAttribute As SldWorks.Attribute ' l'attribut qui contient l'épaisseur. et le matériau
12
13			Private FlagFace_de_section As Integer = 99
14
15			Sub New(ByRef swface As SldWorks.Face2)
16			MyBase.New(swface, 1) ' 1 car c'est une coque
17			End Sub
18
19			Protected Overrides Sub Finalize()
20			Me.lst_Faces.Clear()
21			Me.lst_InterPoutre.Clear()
22			Me.lst_InterCoqueVolume.Clear()
23			MyBase.Finalize()
24			End Sub
25
26
27			''' <summary>
28			''' 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.
29			''' </summary>
30			''' <param name="sPoutre">La SlyPoutre</param>
31			''' <param name="xyz1">Laposition du pount d'intersection</param>
32			''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
33			''' <returns>La classe d'intersection</returns>
34			''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
35			Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreCoque
36
37			Dim int As InterPoutreCoque
38
39			For Each int In lst_InterPoutre
40			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
41			' on a un point déjà existant,
42			int.lst_sPoutre.Add(sPoutre)
43			int.lst_type.Add(tipe)
44			Return int
45			End If
46			Next
47
48
49			' si on est ici c'est que l'on doit créer l'intersection
50			int = New InterPoutreCoque
51
52			int.x = xyz1(0)
53			int.y = xyz1(1)
54			int.z = xyz1(2)
55
56			int.lst_sPoutre.Add(sPoutre)
57			int.lst_type.Add(tipe)
58			int.sFaceCoque = Me
59			lst_InterPoutre.Add(int)
60			Return int
61
62			End Function
63
64
65
66	bournival	48
67	bournival	40	Public Function PossedeFaceDeSection() As Boolean
68
69			If Not Me.FlagFace_de_section = 99 Then Return CBool(Me.FlagFace_de_section)
70			Dim retour As Double
71
72			Dim p As SldWorks.Parameter
73			Try
74			p = swAttribute.GetParameter("Flag")
75			Catch ex As Exception
76			MsgBox("N'arrive pas à se lier à l'attribut pour obtenir la largeur, la poutre n'a peut-être pas d'attributs...")
77			Return Nothing
78			End Try
79
80			retour = p.GetDoubleValue
81			Me.FlagFace_de_section = retour
82			If retour = 1 Then Return True Else Return False
83
84			End Function
85
86
87	bournival	46	''' <summary>
88			''' Donne l'épaisseur de la coque
89			''' </summary>
90			''' <value></value>
91			''' <returns></returns>
92			''' <remarks></remarks>
93			Public ReadOnly Property GetEpaisseur() As Double
94			Get
95			If Not Me.epaisseur = 0 Then Return Me.epaisseur : Exit Property ' pour optimiser
96	bournival	40
97
98	bournival	46	Dim p As SldWorks.Parameter
99	bournival	40
100	bournival	46	Try
101			p = swAttribute.GetParameter("Ep")
102			Catch ex As Exception
103			MsgBox("N'arrive pas à se lier à l'attribut pour obtenir l'épaisseur, la coque n'a peut-être pas d'attributs...")
104			Return 0
105			End Try
106	bournival	40
107	bournival	46	Me.epaisseur = p.GetDoubleValue
108			Return p.GetDoubleValue
109			End Get
110			End Property
111	bournival	40
112
113	bournival	46
114	bournival	40	Public Function GetMateriau() As String
115			If Not Me.materiau Then Return Me.materiau : Exit Function ' pour optimiser
116
117
118			Dim p As SldWorks.Parameter = Nothing
119
120			Try
121			p = swAttribute.GetParameter("M")
122			Catch ex As Exception
123			MsgBox("N'arrive pas à se lier à l'attribut pour obtenir le matériau, la coque n'a peut-être pas d'attributs...")
124			End Try
125			Me.materiau = p.GetStringValue
126			Return p.GetStringValue
127			End Function
128
129			Public Function GetAttribute() As SldWorks.Attribute
130			Dim ent As SldWorks.Entity
131			Dim attr As SldWorks.Attribute = Nothing
132
133			Try
134			ent = lst_Faces.Item(1)
135			attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
136			Me.swAttribute = attr
137			Catch ex As Exception
138			MsgBox("ERREUR! Une coque sans attributs !", MsgBoxStyle.Critical)
139			End Try
140			If IsNothing(attr) Then ' on a trouvé un attribut de coque
141			MsgBox("Une coque sans attributs !")
142			End If
143			Return attr
144			End Function
145
146			Private Function PointInterne(ByRef P1() As Double, ByRef P2() As Double, ByRef centreX As Double, ByRef centreY As Double) As Double()
147			Dim b(1) As Double
148			Dim c(1) As Double
149			Dim d(1) As Double
150			b(0) = P1(0) - centreX
151			b(1) = P1(1) - centreY
152			c(0) = P1(0) - centreX
153			c(1) = P1(1) - centreY
154
155			b = Outils_Math.unitaire(b)
156			c = Outils_Math.unitaire(c)
157
158			d(0) = ((b(0) + c(0)) / 2) * 50 * Epsilon
159			d(1) = ((b(0) + c(0)) / 2) * 50 * Epsilon
160
161			Return d
162
163			End Function
164
165			' cette sub ajoute LES constantes de la coque aux nom de l'entité.
166			Public Sub AddConstantes()
167			' cette sub ajoute LES constantes de la coque aux nom de l'entité.
168			' on suppose qu'il n'y en a pas déjà
169			' tout ce que j'ai à faire c'est de modifier la propriété nom.
170
171			'Format(valeur, "0.00000e+000")
172			Dim epaisseur As Double
173
174
175			epaisseur = Me.GetEpaisseur()
176			If epaisseur <= 0 Then
177			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")
178			epaisseur = 1
179			Dim ent As SldWorks.Entity
180			ent = Me.swFace : ent.Select4(False, Nothing)
181			swModel.SelectedFaceProperties(1, 0, 0, 0, 0, 0, 0, False, "")
182			End If
183
184
185			nom = nom & "¢" & Format(epaisseur, "0.00000e+000") & "MA" & Format(materiau, "00")
186
187			' attention, s'il y a une intersection, je dois la noter et l'ajouter au nom....
188			Dim c As Integer
189			For c = 1 To Len(nom)
190			If Mid(nom, c, 1) = "," Then Mid(nom, c, 1) = "."
191			Next c
192			End Sub
193
194
195
196			Friend Overrides 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) As SldWorks.Face2
197
198			' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
199			' cette procédure doit créer une nouvelle SlyFaceCoque
200			' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
201			' la fonction ne créée pas de nouvelles slyEntités.
202			' si le découpage donne 3 faces ou plus, elles sont placées dans lst_AutreFaces
203
204
205			' 1 - on obtient les 2 nouvelles faces,
206			Dim vFace As Object
207			Dim Face1 As SldWorks.Face2
208			Dim Face2 As SldWorks.Face2
209			Dim FaceInterne As SldWorks.Face2
210			Dim FaceExterne As SldWorks.Face2
211			Dim swFeat As SldWorks.Feature
212
213			swFeat = swModel.FeatureByPositionReverse(0)
214			vFace = swFeat.GetFaces
215
216			If vFace Is Nothing Then Return Nothing ' le code nothing veut dire que la face n'a pas été coupée.
217
218			Face1 = vFace(0)
219			Face2 = vFace(1)
220
221			Try ' vérification
222			Dim face3 As SldWorks.Face2
223			Dim i As Integer
224			'Dim slyFaceSupplémentaire As SlyFaceCoque ' la raison du pourquoi on doit avoir 2 sous-routines
225
226			For i = 2 To 1000
227			face3 = vFace(i)
228			Me.lst_Faces.Add(face3)
229			Next i
230
231			'MsgBox("Problème, on a au moins 3 face dans le update après le découpage", MsgBoxStyle.Critical)
232			Catch ex As Exception
233			' tout est normal...
234			End Try
235
236			' SECRET 1.999 ' c'est pas scientifique mais ça peut marcher
237			If Math.Abs(Face1.GetArea) > Math.Abs(10 * Face2.GetArea) Then
238			FaceInterne = Face2
239			FaceExterne = Face1
240			ElseIf Math.Abs(Face1.GetArea) < Math.Abs(10 * Face2.GetArea) Then
241			FaceInterne = Face1
242			FaceExterne = Face2
243			Else
244
245
246			'' 2 - on a un point, on trouve quelle face est la plus proche.
247			If Commun.Distance(Face1, x, y, z) < Commun.Distance(Face2, x, y, z) Then
248			FaceInterne = Face1
249			FaceExterne = Face2
250			Else
251			FaceInterne = Face2
252			FaceExterne = Face1
253			End If
254			End If
255
256			Me.lst_Faces.Add(FaceInterne)
257			Me.lst_Faces.Add(FaceExterne)
258
259			'' 3 - on créé une nouvelle coque (intérieure) et on lui donne les propriétés originales et on met dans la liste des coques
260			'Me.swFace = FaceExterne
261			Dim aire As Double
262			aire = FaceExterne.GetArea
263
264			' ************************************************
265			' pour placer un attribut sur la face interne
266			Dim attr As SldWorks.Attribute
267			Dim swent As SldWorks.Entity
268			Static no As Integer
269
270			If FI Then
271			Dim nom2 As String = "FaceInterne" & no
272
273			swent = FaceInterne
274			attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
275
276			If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
277
278			While attr Is Nothing
279			no += 1
280			nom2 = "FaceInterne" & CStr(no)
281			attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
282			End While
283			GererDossiers("FaceInternes", nom2)
284			no += 1
285			ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
286			Dim nom2 As String = "FaceInterne" & no
287
288			swent = FaceInterne
289			attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
290
291			If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
292
293			While attr Is Nothing
294			no += 1
295			nom2 = "FaceInterne" & CStr(no)
296			attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
297			End While
298			GererDossiers("FaceInternes", nom2)
299			no += 1
300			MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
301			Else
302			MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
303			End If
304
305			' ********** l'attribut de la condition aux limites *****************
306			'attr = Nothing
307			'Dim nom3 As String
308			'Dim p As SldWorks.Parameter
309			'If Not Me.condition = "" Then
310			' nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
311			' attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
312
313			' While attr Is Nothing
314			' If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, FaceInterne, nom3, 0, 0)
315			' If attr Is Nothing Then nom3 = nom3 & CStr(Timer)
316			' End While
317
318			' p = attr.GetParameter("CL")
319			' p.SetStringValue(Me.condition)
320
321			'End If
322			' GererDossiers("Conditions Aux Limites", nom3)
323			' *****************************************************
324			Return FaceInterne
325
326
327			End Function
328
329			Public Sub SetAttributDeCoque(ByRef epaisseur As Double, Optional ByRef materiau As String = Nothing)
330			Dim nom As String
331			Dim swFace As SldWorks.Face2
332			Dim swent As SldWorks.Entity
333			Dim no As Long
334			Dim Attr As SldWorks.Attribute
335
336			swFace = Me.SwFace
337			swent = swFace
338
339
340			Try
341			Attr = swent.FindAttribute(Intersections.DefAttrRCCoque, 0) ' si l'attribut existe déjà on pointe dessus.
342			Catch ex As Exception
343			'MsgBox("N'arrive pas à se lier à l'attribut!", MsgBoxStyle.Information, "SetAttributsDePoutre")
344			Exit Sub
345			End Try
346
347			If Attr Is Nothing Then Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 2) ' 0 = swThisconfig
348
349			While Attr Is Nothing
350			no += 1
351			nom = "RCCoque" & CStr(no)
352			Attr = Intersections.DefAttrRCCoque.CreateInstance5(swModel, swFace, nom, 0, 0)
353			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")
354
355			End While
356
357
358			Dim ParamM As SldWorks.Parameter
359			Dim ParamEp As SldWorks.Parameter
360
361			ParamM = Attr.GetParameter("M")
362			ParamEp = Attr.GetParameter("Ep")
363
364			If materiau IsNot Nothing Then ParamM.SetStringValue2(materiau, 2, "") ' swAllConfiguration = 2
365			ParamEp.SetStringValue2(epaisseur, 2, "")
366
367			End Sub
368
369
370			End Class
371