ViewVC Help

View File | Revision Log | Show Annotations | View Changeset | Root Listing

root/REPOS_ERICCA/magicsld/SlyFaceVolume.vb

Comparing magicsld/SlyFaceVolume.vb (file contents):
Revision 48 by bournival, Wed Aug 22 21:18:12 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

#	Line 6 | Line 6 | Public Class SlyFaceVolume
6		Inherits SuperFace
7
8
9	<	Sub New(ByVal swface As SldWorks.Face2)
9	>	Sub New(ByVal swface As sldworks.Face2)
10		MyBase.New(swface)
11		End Sub
12
13
14
15	+	Public Overrides Sub decouper()
16	+
17	+	If lst_InterPoutre.Count = 0 Then Exit Sub ' sortir si on a pas d'intersection
18	+
19	+
20	+	' les attributs ne sont pas updatés sur les faces (mais sur les arètes et les sommets c'est OK)
21	+	' on mémorise l'attribut de la face et on la réapplique à la fin.
22	+
23	+
24	+	Dim i As Integer
25	+	Dim inter As InterPoutreVolume
26	+	Dim nb1 As Integer, nb2 As Integer, nb3 As Integer, nb5 As Integer
27	+	Dim poutre1 As SlyAretePoutre = Nothing, poutre3 As SlyAretePoutre = Nothing
28	+	Dim lst_poutre2 As New Collection
29	+	Dim aire As Double
30	+	Dim poutreTest As SlyAretePoutre
31	+
32	+	Dim lst_coupeXinter As New Collection
33	+	Dim lst_coupeXPoutre As New Collection
34	+	Dim lst_coupeLinter As New Collections.Generic.List(Of InterPoutreVolume)
35	+	Dim lst_coupeLPoutre As New Collection
36	+	Dim lst_coupeCinter As New Collection
37	+	Dim lst_coupeCPoutre As New Collection
38	+
39	+
40	+	For Each inter In lst_InterPoutre
41	+	'MsgBox("On découpe l'intersection # " & inter.Numero)
42	+	'pour chaque intersection on peut avoir plusieurs poutres...
43	+	For i = 1 To inter.lst_sPoutre.Count
44	+	poutreTest = inter.lst_sPoutre.Item(i)
45	+	Select Case CInt(inter.lst_type.Item(i))
46	+	Case 1
47	+	If poutreTest.GetAireCarree > aire Then poutre1 = poutreTest
48	+	nb1 += 1
49	+	Case 2
50	+	lst_poutre2.Add(poutreTest)
51	+	nb2 += 1
52	+	Case 3
53	+	If poutreTest.GetAireCarree > aire Then poutre3 = poutreTest
54	+	nb3 += 1
55	+	Case 5 ' un poutre à faceDeSection
56	+	nb5 += 1
57	+	Case 6
58	+	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é...")
59	+
60	+	Case 22
61	+	' on fait rien, mais c'est pour éviter le msgbox du case else...
62	+	Case Else
63	+	MsgBox("Problème dans découper de SlyFaceCoque, le type d'intersection n'est pas reconnu", MsgBoxStyle.Critical)
64	+	End Select
65	+	Next i
66	+
67	+
68	+
69	+	If nb1 > 0 Then 'CoupeX(inter, poutre1) ' on coupe le x en premier
70	+	lst_coupeXinter.Add(inter)
71	+	lst_coupeXPoutre.Add(poutre1)
72	+	End If
73	+
74	+
75	+	For Each poutreTest In lst_poutre2 ' puis on coupe sur la longueur 'CoupeLong(inter, poutreTest)
76	+	lst_coupeLinter.Add(inter)
77	+	lst_coupeLPoutre.Add(poutreTest)
78	+	Next
79	+
80	+	If nb3 > 0 Then 'CoupeCote(inter, poutre3) ' finalement on coupe sur les cotés
81	+	lst_coupeCinter.Add(inter)
82	+	lst_coupeCPoutre.Add(poutre3)
83	+	End If
84	+
85	+	If nb5 = 1 And (nb1 > 0 Or nb2 > 0 Or nb3 > 0) Then
86	+	MsgBox("Problème, on a un type d'intersection impossible dans la vraie vie!", MsgBoxStyle.Exclamation, "Design impossible à obtenir en réalité...")
87	+	End If
88	+
89	+
90	+	lst_poutre2.Clear()
91	+	nb1 = 0 : nb2 = 0 : nb3 = 0
92	+
93	+
94	+	Next inter
95	+
96	+
97	+	' maintenant on a toutes les lists d'intersections.  On les coupe.
98	+	For i = 1 To lst_coupeXinter.Count
99	+	CoupeX(lst_coupeXinter.Item(i), lst_coupeXPoutre.Item(i))
100	+	Next
101	+
102	+	For Each int As InterPoutreVolume In lst_coupeLinter '  i = 1 To lst_coupeLinter.Count
103	+	int.DecouperLong()                               'CoupeLong(lst_coupeLinter.Item(i), lst_coupeLPoutre.Item(i))
104	+	Next
105	+
106	+	' ne devrait pas avoir desoin de ça avec un volume
107	+	'For i = 1 To lst_coupeCinter.Count
108	+	'    CoupeCote(lst_coupeCinter.Item(i), lst_coupeCPoutre.Item(i))
109	+	'Next
110	+
111	+	If nb5 = 1 Then
112	+	If lst_InterPoutre.Count <> 1 Then MsgBox("Plus d'une intersection du type FacedeSection....")
113	+	CoupeFaceDeSection(lst_InterPoutre(1))
114	+	End If
115	+
116	+	End Sub
117	+
118		''' <summary>
119		''' sub qui CRÉÉ une instance de la classe InterPoutreVolume si et seulement si il n'en existe pas avant. S'il en existe alors on update la classe déjà existante.
120		''' </summary>
121		''' <param name="sPoutre">La SlyPoutre</param>
122		''' <param name="xyz1">Laposition du pount d'intersection</param>
123	<	''' <param name="tipe">=1 si on découpe en X, 2 si à l'intérieur, 3 si à l'extérieur</param>
123	>	''' <param name="tipe">=1 si on découpe en X, 2 si coupe Long, 3 si à l'extérieur, 5 si la section est partiellement découpée, 6 si face de section, mais pas sur cette face</param>
124		''' <returns>La classe d'intersection</returns>
125		''' <remarks>dans tous les cas on retourne la classe (pour pouvoir l'ajouter à la poutre...)</remarks>
126		Public Function AjouterInterPoutre(ByRef sPoutre As SlyAretePoutre, ByRef xyz1() As Double, ByVal tipe As Byte) As InterPoutreVolume
#	Line 33 | Line 136 | Public Class SlyFaceVolume
136		End If
137		Next
138
36	–
139		' si on est ici c'est que l'on doit créer l'intersection
140		int = New InterPoutreVolume
141
#	Line 45 | Line 147 | Public Class SlyFaceVolume
147		int.lst_type.Add(tipe)
148		int.sFaceVolume = Me
149		lst_InterPoutre.Add(int)
150	+
151	+	If Commun.OptionMettreNoteIntersection = True Then
152	+	Dim texte As String = "Intersection # " & int.Numero & vbCr & "Poutre Volume FaceSection"
153	+	Commun.CreerAnnotation(xyz1(0), xyz1(1), xyz1(2), texte)
154	+	End If
155		Return int
156
157		End Function
#	Line 52 | Line 159 | Public Class SlyFaceVolume
159
160
161		' sub qui update les pointeurs après un split de la face.
162	<	Friend Overrides Function UpdateApresSplit(ByRef inter As InterPoutreVolume, 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
162	>	Protected Function UpdateApresSplit(ByRef inter As InterPoutreVolume, 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
163		' le pointeur Me.swFace pointe soit sur une face, soit sur la face originale soit la face découpée
164		' cette procédure doit créer une nouvelle SlyFaceVOl
165		' et tout ce que j'ai c'est un pointeur, et je sais même pas lequel.
#	Line 62 | Line 169 | Public Class SlyFaceVolume
169
170		' 1 - on obtient les 2 nouvelles faces,
171		Dim vFace As Object
172	<	Dim Face As SldWorks.Face2 = Nothing
173	<	Dim FaceInterne As SldWorks.Face2
174	<	Dim swFeat As SldWorks.Feature
175	<	Dim swent As SldWorks.Entity = Nothing
176	<	Dim swFaultEnt As SldWorks.FaultEntity
172	>	Dim Face As sldworks.Face2 = Nothing
173	>	Dim FaceInterne As sldworks.Face2
174	>	Dim swFeat As sldworks.Feature
175	>	Dim swent As sldworks.Entity = Nothing
176	>	Dim swFaultEnt As sldworks.FaultEntity
177
178		swFeat = swModel.FeatureByPositionReverse(0)
179		Try
#	Line 76 | Line 183 | Public Class SlyFaceVolume
183		Next Face
184		Catch
185		' si on a une poutre dessinée en partie, on aura pas de feature... mais on a la face...
186	<	' on doit donc l'e déterminer anyway
186	>	' on doit donc le déterminer anyway
187		End Try
188
189
#	Line 93 | Line 200 | Public Class SlyFaceVolume
200		' This method projects the selected sketch items from the current sketch on a selected surface.
201		' en fait ça projette juste une courbe...
202		' et si ça retourne nul alors la projection a pas marchée.
203	<	Dim swSKSeg As SldWorks.SketchSegment
204	<	swSKSeg = Commun.MettreUneLigne(Plan, x - 50 * Epsilon, y, z, x + 100 * Epsilon, y + 100 * Epsilon, z + 100 * Epsilon)
203	>	Dim swSKSeg As sldworks.SketchSegment
204	>	swSKSeg = Commun.MettreUneLigne(Plan, x - 20 * Epsilon, y - 20 * Epsilon, z, x + 20 * Epsilon, y + 20 * Epsilon, z)
205
206		swFeat = Nothing
207		For Each Face In Me.lst_Faces
#	Line 110 | Line 217 | Public Class SlyFaceVolume
217		If swFeat Is Nothing Then
218		' on passe à un autre type d'essai...
219
220	+
221	+
222	+
223		MsgBox("N'a pas réussi à trouver la bonne face dans le UpdateAPrèsSplit")
224		Return Nothing
225		Else
#	Line 120 | Line 230 | Public Class SlyFaceVolume
230
231		' ************************************************
232		' pour placer un attribut sur la face interne
233	<	Dim attr As SldWorks.Attribute
234	<
235	<	Static no As Integer
233	>	Dim attr As sldworks.Attribute
234	>	Dim p2 As sldworks.Parameter
235	>	Dim no As Integer = 0
236
237		If FI Or Flag = 20 Then
238	<	Dim nom2 As String = "FaceInterne" & no
239	<	swent = FaceInterne
240	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
241	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
242	<	While attr Is Nothing
243	<	no += 1
244	<	nom2 = "FaceInterne" & CStr(no)
245	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
246	<	End While
247	<	GererDossiers("FaceInternes", nom2)
248	<	no += 1
238	>	no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
239	>	'Dim nom2 As String = "FaceInterne" & no
240	>	'swent = FaceInterne
241	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
242	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
243	>	'While attr Is Nothing
244	>	'    no += 1
245	>	'    nom2 = "FaceInterne" & CStr(no)
246	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
247	>	'End While
248	>	'p2 = attr.GetParameter("FI")
249	>	'p2.SetDoubleValue(poutre.SuggereGrosseurMaille)
250	>	'GererDossiers("FaceInternes", nom2)
251	>	'no += 1
252		ElseIf Flag = 2 Then ' on a un channel, on fait les 2 options
253	<	Dim nom2 As String = "FaceInterne" & no
254	<
255	<	swent = FaceInterne
256	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
257	<
258	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
259	<
260	<	While attr Is Nothing
261	<	no += 1
262	<	nom2 = "FaceInterne" & CStr(no)
263	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
264	<	End While
265	<	GererDossiers("FaceInternes", nom2)
266	<	no += 1
253	>	'Dim nom2 As String = "FaceInterne" & no
254	>	'swent = FaceInterne
255	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
256	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2) ' 0 = swThisconfig
257	>	'While attr Is Nothing
258	>	'    no += 1
259	>	'    nom2 = "FaceInterne" & CStr(no)
260	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, FaceInterne, nom2, 0, 2)
261	>	'End While
262	>	'p2 = attr.GetParameter("FI")
263	>	'p2.SetDoubleValue(poutre.SuggereGrosseurMaille)
264	>	'GererDossiers("FaceInternes", nom2)
265	>	'no += 1
266	>	no = Me.MettreAttributFaceInterne(FaceInterne, poutre.SuggereGrosseurMaille, True)
267		MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
268		Else
269		MyBase.AjouterMiniPoutresSurFaceInterne(poutre, FaceInterne, inter.x, inter.y, inter.z)
#	Line 159 | Line 272 | Public Class SlyFaceVolume
272		'  ************ l'attribut de la condition aux limites *******************
273		attr = Nothing
274		Dim nom3 As String = Nothing
275	<	Dim p As SldWorks.Parameter
275	>	Dim p As sldworks.Parameter
276		If Not Me.condition = "" Then
277		nom3 = "CLc_" & no & "_" & Me.nom & " " & Me.condition
278		attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
#	Line 179 | Line 292 | Public Class SlyFaceVolume
292
293		End Function
294
295	<	Private Sub MAJ_CL(ByRef FaceInterne As SldWorks.Face)
295	>	Private Sub MAJ_CL(ByRef FaceInterne As sldworks.Face)
296		'  ************ update de 'attribut de la condition aux limites *******************
297	<	Dim attr As SldWorks.Attribute
297	>	Dim attr As sldworks.Attribute
298		Static no As Integer = 0
299	<	Dim swEnt As SldWorks.Entity
299	>	Dim swEnt As sldworks.Entity
300
301		swEnt = FaceInterne
302		attr = Nothing
303		Dim nom3 As String = Nothing
304	<	Dim p As SldWorks.Parameter
304	>	Dim p As sldworks.Parameter
305		If Not Me.condition = "" Then
306		nom3 = "CLv_" & no & "_" & Me.nom & " " & Me.condition
307		attr = swEnt.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
#	Line 207 | Line 320 | Public Class SlyFaceVolume
320
321		End Sub
322
323	+	Protected Sub CoupeX(ByRef inter As InterPoutreVolume, ByRef poutre As SlyAretePoutre)
324	+	Dim swEnt As sldworks.Entity = Nothing
325	+	Dim Directionnel As Boolean, Flip As Boolean
326	+	Dim Faces(3) As sldworks.Face2
327	+	Dim r(2) As Double
328	+	Dim LaSurface As sldworks.Surface
329	+	Dim sens As Boolean
330	+	Dim p(2) As Double
331	+	Dim retour() As Double
332	+
333	+	'swModel.SetInferenceMode(False) ' ne pas mettre de contraintes par défaut
334	+	'swModel.SetAddToDB(True)
335	+	'swModel.SetDisplayWhenAdded(False) ' accélérer les performances
336	+
337	+
338	+	' l'idée est de sélectionner le point et l'arète puis d'utiliser CreatePlanePerCurveAndPassPoint3
339	+	Dim planReference As sldworks.RefPlane
340	+	Dim swsketch As sldworks.Sketch
341	+	Dim swSommet As sldworks.Vertex, swSommet2 As sldworks.Vertex
342	+	Dim pointdeb(2) As Double, pointfin(2) As Double
343	+
344	+	'swModel.Extension.SelectByID2("", "POINTREF", inter.x, inter.y, inter.z, False, 0, Nothing, 0)
345	+	' faut vraiment sélectionner le bon point...
346	+	swSommet = poutre.swArete.GetStartVertex()
347	+	swSommet2 = poutre.swArete.GetEndVertex()
348	+	If swSommet Is Nothing Then
349	+	MsgBox("On a un cercle ou courbe sans sommets, dans coupeX, pas encore traité.  Ne peut pas mettre un plan si pas de sommet")
350	+	Else
351	+	If Distance(swSommet, inter.x, inter.y, inter.z) < Epsilon Then
352	+	swEnt = swSommet
353	+	ElseIf Distance(swSommet2, inter.x, inter.y, inter.z) < Epsilon Then
354	+	swEnt = swSommet2
355	+	Else
356	+	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")
357	+	End If
358	+	End If
359	+
360	+	swEnt.Select4(False, Nothing)
361	+	swEnt = poutre.swArete
362	+	swEnt.Select(True)
363	+
364	+	If Me.estPlan Or Me.estFauxPlan(inter.x, inter.y, inter.z) Then
365	+	' 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
366	+	planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
367	+	Directionnel = False
368	+	Flip = False
369	+	ElseIf Me.estCylindre Then
370	+	' 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é.
371	+	Dim PlanDessus As sldworks.RefPlane
372	+	Dim Rayon As Double, L As Double, B As Double, phi As Double, dist As Double, temp1 As Double, temp2 As Double
373	+	Dim u(2) As Double, v(2) As Double
374	+	PlanDessus = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
375	+	temp1 = poutre.GetD1
376	+	temp2 = poutre.GetD2
377	+	L = Math.Sqrt(temp1 * temp1 + temp2 * temp2)
378	+	Rayon = Me.GetRayonCylindre()
379	+	u = poutre.GetOrientation(inter.x, inter.y, inter.z)
380	+	v = Me.GetNormale(inter.x, inter.y, inter.z)
381	+	phi = -(Math.Acos(Outils_Math.cosdir(u, v)))
382	+	B = Math.Abs(L / 2 * Math.Sin(phi))
383	+	dist = Rayon - Math.Sqrt(Rayon * Rayon - ((L / 2) * (L / 2))) + B
384	+	If dist < 0 Then MsgBox("Gros problème pour couper le cylindre, la poutre est plus grosse!!!!!!", MsgBoxStyle.Critical) : Exit Sub
385	+
386	+	swEnt = PlanDessus
387	+	swEnt.Select(False)
388	+	Directionnel = True
389	+
390	+	Flip = Flipper(PlanDessus, inter)
391	+
392	+	planReference = swModel.CreatePlaneAtOffset3(dist * 2, Flip, True)
393	+	Else
394	+	MsgBox("La coque n'est ni un cylindre, ni un plan" & vbCr & "Le résultat n'est pas certain...", MsgBoxStyle.Information, "Avertissement")
395	+	planReference = swModel.CreatePlanePerCurveAndPassPoint3(True, True)
396	+	Directionnel = False
397	+	Flip = False
398	+	End If
399	+
400	+
401	+
402	+	LaSurface = Me.SwFace.GetSurface()
403	+	sens = Me.SwFace.FaceInSurfaceSense()
404	+
405	+	' 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.
406	+	Dim i As Integer, MettreFI As Boolean
407	+	Dim swFeat As sldworks.Feature
408	+
409	+	For i = 0 To 1
410	+
411	+	swEnt = planReference
412	+	swEnt.Select(False)
413	+	swModel.InsertSketch2(False)
414	+	swModel.ClearSelection2(True)
415	+	swFeat = swModel.FeatureByPositionReverse(0)
416	+	swModel.SelectByID(swFeat.Name, "SKETCH", 0, 0, 0)
417	+	swModel.EditSketch()
418	+	swsketch = swModel.GetActiveSketch2
419	+
420	+	p(0) = inter.x : p(1) = inter.y : p(2) = inter.z
421	+	retour = Commun.TransfertModelSketch(swsketch, p)
422	+
423	+
424	+	r = DessineSectionPoutre(poutre, retour(0), retour(1), i + 1, swsketch, inter, MettreFI)
425	+	swModel.InsertSketch2(True) ' l'option true rebuild le modèle avec les modifications du sketch.
426	+	swModel.ClearSelection2(True)
427	+
428	+	Dim face As sldworks.Face2
429	+	For Each face In Me.lst_Faces
430	+	swModel.ClearSelection2(True)
431	+	swEnt = face : swEnt.Select2(False, 1)
432	+	swEnt = swsketch : swEnt.Select2(True, 4)
433	+	swModel.InsertSplitLineProject(Directionnel, Flip)
434	+	Next
435	+
436	+
437	+	Me.SwFace.DetachSurface()
438	+	Me.SwFace.AttachSurface(LaSurface, sens)
439	+
440	+	Faces(i) = UpdateApresSplit(inter, poutre, r(0), r(1), r(2), planReference, MettreFI)
441	+	Commun.MettreUnPoint(r(0), r(1), r(2))
442	+
443	+	If Faces(i) Is Nothing Then
444	+	swEnt.Select(False)
445	+	swModel.EditDelete()
446	+	End If
447	+	If Flag = 2 Then Flag = 0 : Exit For
448	+
449	+	Next i
450	+	End Sub
451	+
452
453
454

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines