REPOS_ERICCA/magicsld/SlyFaceCoque.vb

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