ViewVC Help

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

root/REPOS_ERICCA/magicsld/PoGCode.vb

Comparing magicsld/PoGCode.vb (file contents):
Revision 40 by bournival, Mon Aug 20 21:30:28 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

#	Line 1 | Line 1
1		Imports System
2		Imports System.IO
3	+	Imports SolidWorks.Interop
4	+	Imports SolidWorks.Interop.swconst
5	+	Imports SolidWorks.Interop.swpublished
6		Module PoGCode
7		Private TabPoints(,) As Double
8		Private tabpointsface() As SldWorks.Face2
#	Line 40 | Line 43 | Module PoGCode
43		'  -    Tous les points d'échantillonnage créés se retrouvent dans "tabpoint"
44		'       on écrit le fichier des points d'échantillonnage à partir de se tableau
45
46	<	Public Function debut(ByVal Eng As Double, ByVal NbCouches As Integer, ByVal ArrondiBool As Boolean, ByVal Arrondis As Double, ByVal rentrantBool As Boolean, ByVal rentrant As Double, ByVal matiereBool As Boolean, ByVal matiere As Double, ByVal entitésbool As Boolean, ByVal entités As SldWorks.PropertyManagerPageSelectionbox, ByVal Entities As Double, ByVal RaffInd As Boolean) As String
46	>	Public Function DebutManuel(ByVal Eng As Double, ByVal NbCouches As Integer, ByVal ArrondiBool As Boolean, ByVal Arrondis As Double, ByVal rentrantBool As Boolean, ByVal rentrant As Double, ByVal matiereBool As Boolean, ByVal matiere As Double, ByVal entitésbool As Boolean, ByVal entités As SldWorks.PropertyManagerPageSelectionbox, ByVal Entities As Double, ByVal RaffInd As Boolean) As String
47		Dim frequence As Integer
48		Dim vbody As Object
49		Dim grill As New grille
50		Dim Bbox() As Double
51		Dim path As String
49	–	Dim erx_rm As Double
52
53
54		Dim CMDialogl As New Windows.Forms.SaveFileDialog
#	Line 61 | Line 63 | Module PoGCode
63		If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!") : Return ""
64
65		'MsgBox("Début de la routine de pré-optimisation" & vbCr & vbCr & "l'écart nodal global est de : " & Eng & vbCr & "La zone de transition : " & NbCouches & vbCr & "Les arrondis sont à : " & Arrondis & vbCr & "Arretes rentrantes: " & rentrant & vbCr & "Les retraits matière: " & matiere & vbCr & vbCr & "Arrondi = " & ArrondiBool & vbCr & "Rentrant = " & rentrantBool & vbCr & "Matiere = " & matiereBool)
66	<	vBodies = swPart.GetBodies2(SwConst.swBodyType_e.swAllBodies, True)
66	>	vBodies = swPart.GetBodies2(swconst.swBodyType_e.swAllBodies, True)
67	>
68	>	Erase TabPoints ' Sylvain : modifs si on veut plus d'un corps
69	>	Erase Tabface
70	>	Erase TabFaceDouble
71	>	Erase TabEdge
72	>	Erase TabEdgeDouble
73	>	cpt = 0
74	>	BoiteEnglobante() ' Sylvain: Ajouté car je veut la boite totale, et non la boite de chaque volume
75	>
76		For Each vbody In vBodies
77	<	cpt = 0
78	<	Erase TabPoints
79	<	Erase Tabface
80	<	Erase TabFaceDouble
81	<	Erase TabEdge
82	<	Erase TabEdgeDouble
77	>	'cpt = 0
78	>	'Erase TabPoints
79	>	'Erase Tabface
80	>	'Erase TabFaceDouble
81	>	'Erase TabEdge
82	>	'Erase TabEdgeDouble
83
84		swbody = vbody
85	<	BoiteEnglobante()
85	>	'BoiteEnglobante() ' Sylvain: Retiré car je veut la boite totale, et non la boite de chaque volume
86		initialisation()
87
88		'initialistation de la grille
89	<	Dim Coeffmax As Double = Math.Max(Math.Max(Arrondis, matiere), Math.Max(rentrant, Entities))
90	<	Dim taillecase As Double = Eng * (1 - Coeffmax)
89	>	Dim Coeffmin As Double = Math.Min(Math.Min(Arrondis, matiere), Math.Min(rentrant, Entities))
90	>	Dim taillecase As Double = Eng * (1 - Coeffmin)
91		Bbox = swbody.GetBodyBox
92		' on initialise la grille 0.5 pourcent supérieur à la bounding box
93		grill.initialiser(Bbox(0) - (Bbox(3) - Bbox(0)) * 0.005, Bbox(1) - (Bbox(4) - Bbox(1)) * 0.005, Bbox(2) - (Bbox(5) - Bbox(2)) * 0.005, Bbox(3) + (Bbox(3) - Bbox(0)) * 0.005, Bbox(4) + (Bbox(4) - Bbox(1)) * 0.005, Bbox(5) + (Bbox(5) - Bbox(2)) * 0.005, Int((Bbox(3) - Bbox(0) + 2 * (Bbox(3) - Bbox(0)) * 0.005) / taillecase), Int((Bbox(4) - Bbox(1) + 2 * (Bbox(4) - Bbox(1)) * 0.005) / taillecase), Int((Bbox(5) - Bbox(2) + 2 * (Bbox(5) - Bbox(2)) * 0.005) / taillecase))
#	Line 87 | Line 98 | Module PoGCode
98		End If
99		' Si la case retrait matiere est cochée
100		If matiereBool = True Then
101	<	erx_rm = determination_precision_retrait_mat(Eng, matiere)
91	<	raffinement_retrait_matiere(Eng, erx_rm)
92	<	'testretraitMatiere(Eng, erx_rm)
101	>	testretraitMatiere(matiere)
102		End If
103		' si la case rentrant est cochée
104		If rentrantBool = True Then
#	Line 120 | Line 129 | Module PoGCode
129		fichiertxt(Eng, path)
130		swModel.ClearSelection2(True)
131		testPog(False, False, False, True, False)
132	<	Return path
132	>	'Return path
133		Next vbody
134	+	Return path ' Sylvain : je crois que ça va à l'extérieur de la boucle...
135	+	End Function
136	+
137	+	''' <summary>
138	+	''' Function POur traiter la préoptimisation de façon automatique
139	+	''' </summary>
140	+	''' <param name="Erx">Premier paramètre</param>
141	+	''' <param name="LimPT">youjhou</param>
142	+	''' <returns></returns>
143	+	''' <remarks></remarks>
144	+	Public Function DebutAutomatique(ByVal Erx As Double, ByVal LimPT As Double) As String
145	+
146	+	Dim vbody As Object
147	+	Dim grill As New grille
148	+	Dim Bbox() As Double
149	+	Dim path As String
150	+	Dim Eng As Double = 0
151	+	Dim coef_min As Double
152	+	Erx = (100 - Erx) / 100 ' valeur d'erreur d'analyse exacte a priori
153	+
154	+
155	+	Dim CMDialogl As New Windows.Forms.SaveFileDialog
156	+	CMDialogl.DefaultExt = ".txt"
157	+	CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
158	+
159	+	CMDialogl.OverwritePrompt = True
160	+	CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
161	+	CMDialogl.ShowDialog()
162	+	path = CMDialogl.FileName
163	+	path = Txtpath(path)
164	+	If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!") : Return ""
165	+
166	+	vBodies = swPart.GetBodies2(swconst.swBodyType_e.swAllBodies, True)
167	+
168	+	cpt = 0 ' Sylvain: Ajouté pour traiter plus d'un corps
169	+	Erase TabPoints
170	+	Erase Tabface
171	+	Erase TabFaceDouble
172	+	Erase TabEdge
173	+	Erase TabEdgeDouble
174	+
175	+	BoiteEnglobante() ' Sylvain: Ajouté car je veut la boite totale, et non la boite de chaque volume
176	+	For Each vbody In vBodies
177	+	'cpt = 0
178	+	'Erase TabPoints
179	+	'Erase Tabface
180	+	'Erase TabFaceDouble
181	+	'Erase TabEdge
182	+	'Erase TabEdgeDouble
183	+
184	+	swbody = vbody
185	+	'BoiteEnglobante() ' Sylvain: Retiré car je veut la boite totale, et non la boite de chaque volume
186	+	initialisation()
187	+
188	+	'Calul de Eng
189	+	Eng = determination_ecart_nodal_global_retraits_mat(Erx, coef_min)
190	+	If Eng = 0 Then Continue For
191	+
192	+	'initialistation de la grille
193	+
194	+	Dim taillecase As Double = Eng * (1 - coef_min)
195	+	Bbox = swbody.GetBodyBox
196	+	' on initialise la grille 0.5 pourcent supérieur à la bounding box
197	+	grill.initialiser(Bbox(0) - (Bbox(3) - Bbox(0)) * 0.005, Bbox(1) - (Bbox(4) - Bbox(1)) * 0.005, Bbox(2) - (Bbox(5) - Bbox(2)) * 0.005, Bbox(3) + (Bbox(3) - Bbox(0)) * 0.005, Bbox(4) + (Bbox(4) - Bbox(1)) * 0.005, Bbox(5) + (Bbox(5) - Bbox(2)) * 0.005, Int((Bbox(3) - Bbox(0) + 2 * (Bbox(3) - Bbox(0)) * 0.005) / taillecase), Int((Bbox(4) - Bbox(1) + 2 * (Bbox(4) - Bbox(1)) * 0.005) / taillecase), Int((Bbox(5) - Bbox(2) + 2 * (Bbox(5) - Bbox(2)) * 0.005) / taillecase))
198	+
199	+
200	+	raffinement_retrait_matiere(Eng, Erx, LimPT)
201	+
202
203	+	' on crée les points d'échantillonnage sur les sommets
204	+	CreerPointsVertex(Eng, grill)
205	+	' on crée les points d'échantillonnage sur les arêtes
206	+	CreerPointsEdge(Eng, grill)
207	+	' on crée les points d'échantillonnage sur les faces
208	+	CreerPointsFace(Eng, grill)
209	+
210	+
211	+	' on créée le fichier d'échantillonnage
212	+	fichiertxt(Eng, path)
213	+	swModel.ClearSelection2(True)
214	+	testPog(False, False, False, True, False)
215	+	'Return path
216	+	Next vbody
217	+	Return path ' sylvain : Je crios aussi que ça vient à l'extérieur de la boucle
218		End Function
219	+
220		Sub entitéselection(ByRef coeff As Double, ByRef Ind As Boolean)
221		Dim swSelMgr As SldWorks.SelectionMgr
222		Dim i As Integer
#	Line 370 | Line 463 | Module PoGCode
463		Next cpt1
464
465		End Sub
466	<	Sub testretraitMatiere(ByRef Eng As Double, ByRef erx As Double)
466	>	Sub testretraitMatiere(ByRef coeff As Double)
467
468		Dim swface As SldWorks.Face2
469		Dim swsurface As SldWorks.Surface
#	Line 380 | Line 473 | Module PoGCode
473		Dim cpt1 As Integer
474		Dim cpt2 As Integer
475		Dim swedge As SldWorks.Edge
383	–	Dim swedgetmp As SldWorks.Edge
476		Dim vedge As Object
477		Dim vface As Object
478		Dim cpt3 As Integer
387	–	Dim cpt4 As Integer
479		Dim i As Integer
480		Dim swent As SldWorks.Entity
481		Dim bRet As Boolean
482	<	Dim lmbd_rm As Integer
483	<	Dim courb_rm As Double
393	<	Dim coeff As Double
394	<	Dim lg As Double
395	<	Dim lgi As Double
396	<	Dim angle As Double
397	<	Dim n(2) As Double
398	<	Dim area As Double
399	<	Dim select_loop As Integer
400	<	Dim t As Double
401	<	Dim diametre As Double = 0
402	<	Dim tmp() As Double
403	<
404	<
405	<	lmbd_rm = 0
406	<	courb_rm = 0
482	>	Dim lmbd_rm As Double = 4
483	>	Dim courb_rm As Double = 0
484
485		swfaceref = swbody.GetFirstFace
486	+
487		For cpt1 = 0 To swbody.GetFaceCount - 1
410	–	diametre = 0
488		swfeat = swfaceref.GetFeature
489		swsurface = swfaceref.GetSurface
490		swloop = swfaceref.GetFirstLoop
491		For cpt2 = 0 To swfaceref.GetLoopCount - 1
415	–	select_loop = 0
492		If swloop.IsOuter = False Then
493		vedge = swloop.GetEdges
494		For cpt3 = 0 To swloop.GetEdgeCount - 1
495		swedge = vedge(cpt3)
496		vface = swedge.GetTwoAdjacentFaces
497	<	swface = vface(0)
498	<	If swface.IsSame(swfaceref) = True Then swface = vface(1)
499	<	angle = GetAngle(swedge, swfaceref, swface)
500	<	If angle < 179 Then
501	<	If (select_loop = 0) Then
502	<
427	<	n = direction_retrait_matiere(swloop, swfaceref)
428	<	lg = 0
429	<	For cpt4 = 0 To swloop.GetEdgeCount - 1
430	<	swedgetmp = vedge(cpt4)
431	<	lgi = get_edge_plane_lenght(swedgetmp, n)
432	<	lg = lg + lgi
433	<	Next cpt4
434	<	area = get_loop_plane_area(swloop, n)
435	<
436	<	diametre = 4 * area / lg
437	<
438	<	select_loop = 1
439	<	End If
440	<	If diametre > 0.000001 Then
441	<	If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swface, coeff, lmbd_rm, courb_rm)
497	>	For i = 0 To 1
498	>	swface = vface(i)
499	>	If swface.IsSame(swfaceref) = False Then
500	>	If GetAngle(swedge, swfaceref, swface) < 179 Then
501	>	ChangeTabFace(swface, coeff)
502	>	End If
503		End If
504	<	End If
504	>	Next i
505		Next cpt3
506		Else
507		If swfeat.GetTypeName = "HoleWzd" Then
508	<	diametre = 0
448	<	Dim hole As SldWorks.WizardHoleFeatureData2
449	<	hole = swfeat.GetDefinition
450	<	Select Case hole.Type
451	<	Case 0, 2 To 5, 7 To 9
452	<	diametre = hole.Diameter
453	<	Case 1, 6
454	<	diametre = (hole.MajorDiameter - hole.MinorDiameter) / 2
455	<	Case 10 To 13, 22 To 24, 43
456	<	diametre = hole.HoleDiameter
457	<	Case 14 To 21, 25 To 30, 44, 45
458	<	diametre = hole.ThruHoleDiameter
459	<	Case 31, 32, 37, 38, 46, 47
460	<	diametre = hole.TapDrillDiameter
461	<	Case 33 To 36, 39 To 42, 48 To 55
462	<	diametre = hole.ThruTapDrillDiameter
463	<	Case Else
464	<	MsgBox("Type de trou non reconnu")
465	<	End Select
466	<	If diametre > 0.000001 Then
467	<	If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swfaceref, coeff, lmbd_rm, courb_rm)
468	<	End If
508	>	ChangeTabFace(swfaceref, coeff)
509		Else
510	<	If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
511	<	diametre = 0
512	<	Dim params() As Double
473	<	If swsurface.Identity = 4002 Then
474	<	params = swsurface.CylinderParams
475	<	diametre = params(6) * 2
476	<	End If
477	<	If swsurface.Identity = 4003 Then
478	<	params = swsurface.ConeParams
479	<	diametre = params(6) * 2
480	<	End If
481	<	If swsurface.Identity = 4005 Then
482	<	params = swsurface.TorusParams
483	<	diametre = params(7) * 2
484	<	End If
485	<	If diametre > 0.000001 Then
486	<	If raffinn_auto_retrait_mat(erx, coeff, lmbd_rm, courb_rm, Eng, diametre / 2, tmp) Then ChangeTabFace(swfaceref, coeff, lmbd_rm, courb_rm)
510	>	If swfeat.GetFaceCount = 1 And swfeat.GetTypeName = "Cut" Then
511	>	If swsurface.Identity = 4002 Or swsurface.Identity = 4003 Or swsurface.Identity = 4005 Then
512	>	ChangeTabFace(swfaceref, coeff)
513		End If
514		End If
515		End If
#	Line 492 | Line 518 | Module PoGCode
518		Next cpt2
519		swfaceref = swfaceref.GetNextFace
520		Next cpt1
521	+
522		End Sub
523		Sub testAngleMatiere(ByRef coeff As Double)
524
#	Line 504 | Line 531 | Module PoGCode
531		Dim cpt1 As Integer
532		Dim Phi As Double
533		Dim swcurve As SldWorks.Curve
534	<	Dim lmbd_am As Integer
535	<	Dim courb_am As Double
536	<	lmbd_am = 6
510	<	courb_am = 2
534	>	Dim lmbd_am As Double = 4
535	>	Dim courb_am As Double = 0
536	>
537
538		vedge = swbody.GetEdges
539		' on test les arete et on prend celles qui sont des lignes
#	Line 1379 | Line 1405 | Module PoGCode
1405		End If
1406		Return path
1407		End Function
1408	+
1409	+
1410		Sub BoiteEnglobante()
1411		' Ecrit la boite englobante dans le tableau de points
1412	<	Dim BodyBox() As Double
1413	<	Dim cpt1 As Integer
1412	>	Dim vBox As Object = swPart.GetPartBox(True)
1413	>	Dim box() As Double = vBox
1414
1415	<	BodyBox = swbody.GetBodyBox
1416	<	ReDim Preserve TabPoints(8, cpt)
1415	>	Dim centre(2) As Double ' le centre de la boite englobante
1416	>	Dim longueurs(2) As Double
1417
1418	<	For cpt1 = 0 To 5
1419	<	TabPoints(cpt1, 0) = BodyBox(cpt1)
1420	<	Next cpt1
1418	>	centre(0) = (box(3) + box(0)) / 2
1419	>	centre(1) = (box(4) + box(1)) / 2
1420	>	centre(2) = (box(5) + box(2)) / 2
1421	>
1422	>	longueurs(0) = (box(3) - box(0)) * 1.25
1423	>	longueurs(1) = (box(4) - box(1)) * 1.25
1424	>	longueurs(2) = (box(5) - box(2)) * 1.25
1425	>
1426	>	ReDim Preserve TabPoints(8, cpt)
1427	>	TabPoints(0, 0) = centre(0) - longueurs(0) / 2
1428	>	TabPoints(1, 0) = centre(1) - longueurs(1) / 2
1429	>	TabPoints(2, 0) = centre(2) - longueurs(2) / 2
1430	>	TabPoints(3, 0) = centre(0) + longueurs(0) / 2
1431	>	TabPoints(4, 0) = centre(1) + longueurs(1) / 2
1432	>	TabPoints(5, 0) = centre(2) + longueurs(2) / 2
1433	>
1434	>	'Dim BodyBox() As Double
1435	>	'Dim cpt1 As Integer
1436	>	'BodyBox = swbody.GetBodyBox
1437	>	'ReDim Preserve TabPoints(8, cpt)
1438	>
1439	>	'For cpt1 = 0 To 5
1440	>	'    TabPoints(cpt1, 0) = BodyBox(cpt1)
1441	>	'Next cpt1
1442
1443		End Sub
1444		Sub initialisation()
#	Line 1623 | Line 1672 | Module PoGCode
1672		swedge = TabEdge(cpt2)
1673		vEdgeU = swedge.GetCurveParams2
1674		longueur = GetEdgeLenght(swedge)
1675	<	pasmax = distance_entre_points(Eng, TabEdgeDouble(0, cpt2), TabEdgeDouble(1, cpt2), TabEdgeDouble(2, cpt2), 0.15)
1675	>	pasmax = distance_entre_points(Eng, TabEdgeDouble(0, cpt2), TabEdgeDouble(1, cpt2), TabEdgeDouble(2, cpt2))
1676
1677		nbpas = 3 * Math.Max(2, Math.Floor(longueur / pasmax - 0.0001) + 1)
1678		pas = (vEdgeU(7) - vEdgeU(6)) / nbpas
#	Line 1709 | Line 1758 | Module PoGCode
1758		vSurfParam = swsurf.Parameterization
1759
1760		vUVlong = GetUVLong(swface)
1761	<	pasmax = distance_entre_points(Eng, TabFaceDouble(0, cpt3), TabFaceDouble(1, cpt3), TabFaceDouble(2, cpt3), 0.15)
1761	>	pasmax = distance_entre_points(Eng, TabFaceDouble(0, cpt3), TabFaceDouble(1, cpt3), TabFaceDouble(2, cpt3))
1762
1763		nbpasU = 3 * Math.Max(2, Math.Floor(vUVlong(0) / pasmax - 0.0001) + 1)
1764		nbpasV = 3 * Math.Max(2, Math.Floor(vUVlong(1) / pasmax - 0.0001) + 1)
#	Line 2133 | Line 2182 | Module PoGCode
2182
2183
2184		End Sub
2185	<	Function distance_entre_points(ByVal eng As Double, ByVal coef As Double, ByVal lmbd As Double, ByVal courbure As Double, ByVal erreur As Double) As Double
2185	>	Function distance_entre_points(ByVal eng As Double, ByVal coef As Double, ByVal lmbd As Double, ByVal courbure As Double, Optional ByVal erreur As Double = 1) As Double
2186		Dim rmax As Double
2187	+	Dim nor As Double = 0.5
2188	+	Dim eni As Double = eng * coef
2189	+	Dim enmax As Double = eng * coef * (1 + erreur)
2190
2139	–	If courbure <= 0 Then
2140	–	rmax = erreur
2141	–	End If
2191
2192	<	If courbure > 0 Then
2193	<	rmax = -0.05 * (Math.Sqrt(1 - 40 * courbure * erreur * (erreur - 1)) - 1) / ((erreur - 1) * courbure)
2145	<	End If
2192	>	If (courbure > 0.0001) Then rmax = 0.05 * (Math.Sqrt((nor * (eng - enmax) - eni + enmax) * (nor * (eng - enmax) - eni + enmax) - 40 * courbure * nor * (eni - enmax) * (eng - enmax)) - nor * (eng - enmax) + eni - enmax) / (courbure * nor * (eng - enmax))
2193	>	If (courbure <= 0.0001) Then rmax = (enmax - eni) / (nor * (eng - enmax) - eni + enmax)
2194
2147	–	'If courbure < 0 Then
2148	–	'    rmax = 0.05 * (Math.Sqrt(40 * courbure * erreur * (erreur - 1) + 1) + 20 * erreur * courbure - 1) / (erreur * courbure)
2149	–	'End If
2195
2196		Return 2 * rmax * lmbd * eng * (1 - coef)
2197
#	Line 2691 | Line 2736 | Module PoGCode
2736		End If
2737		direction_retrait_matiere = n
2738		End Function
2739	<	Function raffinn_auto_retrait_mat(ByVal Erx_ref As Double, ByRef coef As Double, ByRef lmbd As Double, ByRef courb As Double, ByVal Dng As Double, ByVal rayon As Double, ByRef params() As Double) As Boolean
2739	>	Function raffinn_auto_retrait_mat(ByVal Erx_ref As Double, ByRef coef As Double, ByRef lmbd As Double, ByRef courb As Double, ByVal Dng As Double, ByVal rayon As Double, ByVal pentelimite As Double, ByRef params() As Double) As Boolean
2740		Dim delta_ref_theo As Double
2741		Dim delta_ref_ptlimite As Double
2742		Dim Eng_ref As Double
#	Line 2701 | Line 2746 | Module PoGCode
2746		Dim A As Double = 0.12
2747		Dim B As Double = 0.68
2748		Dim param_rm() As Double
2704	–	Dim pentelimite As Double = 0.25
2749
2750		Dim x As Double
2751		Dim pente As Double
#	Line 2760 | Line 2804 | Module PoGCode
2804		ReDim param(4)
2805		param(0) = A : param(1) = B : param(2) = C : param(3) = D
2806		End Function
2807	<	Function determination_precision_retrait_mat(ByRef Eng As Double, ByRef coeff_rm As Double) As Double
2807	>	Function determination_ecart_nodal_global_retraits_mat(ByRef Erx_m As Double, ByRef coeffmin As Double) As Double
2808
2809		Dim swface As SldWorks.Face2
2810		Dim swsurface As SldWorks.Surface
#	Line 2775 | Line 2819 | Module PoGCode
2819		Dim vface As Object
2820		Dim cpt3 As Integer
2821		Dim cpt4 As Integer
2778	–	Dim i As Integer
2779	–	Dim swent As SldWorks.Entity
2780	–	Dim bRet As Boolean
2781	–	Dim lmbd_rm As Integer
2782	–	Dim courb_rm As Double
2822		Dim lg As Double
2823		Dim lgi As Double
2824		Dim angle As Double
2825		Dim n(2) As Double
2826		Dim area As Double
2827		Dim select_loop As Integer
2789	–	Dim t As Double
2828		Dim diametre As Double = 0
2829		Dim nb_retrait_mat As Integer = 0
2830		Dim param(1) As Double
2831	<	Dim Eni_moy As Double = Eng * coeff_rm
2831	>	Dim Eng_moy As Double = 0
2832	>	Dim Eng_ref As Double = 0
2833		Dim tmp() As Double
2834	+	Dim Eni As Double
2835
2836		ReDim Preserve Tabretrait_mat(0)
2837		Tabretrait_mat(0) = New retrait_mat(Nothing, 0)
2838	+	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2839
2840		swfaceref = swbody.GetFirstFace
2841		For cpt1 = 0 To swbody.GetFaceCount - 1
#	Line 2827 | Line 2868 | Module PoGCode
2868		select_loop = 1
2869		End If
2870		If diametre > 0.000001 Then
2871	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2872	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2873	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swface, diametre)
2874	<	End If
2871	>	nb_retrait_mat = nb_retrait_mat + 1
2872	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2873	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swface, diametre)
2874	>	If Eni = 0 Then Eni = diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(1, 2, tmp), param(1)))
2875	>	Eni = Math.Min(Eni, diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1)))) ' calcul du Eni minimal sur le domaine
2876	>	End If
2877		End If
2878		Next cpt3
2879		Else
#	Line 2855 | Line 2898 | Module PoGCode
2898		MsgBox("Type de trou non reconnu")
2899		End Select
2900		If diametre > 0.000001 Then
2901	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2902	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2903	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)
2904	<
2901	>	nb_retrait_mat = nb_retrait_mat + 1
2902	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2903	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swfaceref, diametre)
2904	>	If Eni = 0 Then Eni = diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(1, 2, tmp), param(1)))
2905	>	Eni = Math.Min(Eni, diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1)))) ' calcul du Eni minimal sur le domaine
2906		End If
2907		Else
2908		If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
#	Line 2877 | Line 2921 | Module PoGCode
2921		diametre = params(7) * 2
2922		End If
2923		If diametre > 0.000001 Then
2924	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2925	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2926	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)
2924	>	nb_retrait_mat = nb_retrait_mat + 1
2925	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2926	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swfaceref, diametre)
2927	>	If Eni = 0 Then Eni = diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(1, 2, tmp), param(1)))
2928	>	Eni = Math.Min(Eni, diametre / 2 * Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1)))) ' calcul du Eni minimal sur le domaine
2929		End If
2930		End If
2931		End If
#	Line 2889 | Line 2935 | Module PoGCode
2935		swfaceref = swfaceref.GetNextFace
2936		Next cpt1
2937
2938	<	If nb_retrait_mat > 0 Or Tabretrait_mat(0).diametre > 0 Then
2938	>	If nb_retrait_mat Then
2939	>	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2940	>	Eng_ref = Erx_m / (param(0) * Math.Pow(contrainte_vm_rm_ref(1, 2, tmp), param(1))) ' Calcul de En_reference à une distance de 1 fois le rayon de reference (fin de zone à gradients de contraintes perturbés)
2941		diametre = 0
2942	<	For cpt1 = 0 To nb_retrait_mat
2942	>	For cpt1 = 0 To nb_retrait_mat - 1
2943		diametre = diametre + Tabretrait_mat(cpt1).diametre
2944		Next
2945	<	diametre = diametre / (nb_retrait_mat + 1)
2946	<	Eni_moy = 2 * Eni_moy / diametre  ' devient Eni moy reference
2947	<	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, param)
2948	<	determination_precision_retrait_mat = Eni_moy * param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1))
2949	<	MsgBox("Pré-optimisation de maillage des caractéristiques Retraits de matière avec une précision de " & 100 * determination_precision_retrait_mat & "%")
2945	>	diametre = diametre / nb_retrait_mat
2946	>
2947	>	Eng_moy = Eng_ref * diametre / 2
2948	>	determination_ecart_nodal_global_retraits_mat = Eng_moy
2949	>	coeffmin = Eni / Eng_moy
2950	>	'MsgBox("Pré-optimisation de maillage des caractéristiques Retraits de matière avec une écart nodal global de " & 1000 * Eng_moy & "mm")
2951		Else
2952	<	determination_precision_retrait_mat = 1
2952	>	determination_ecart_nodal_global_retraits_mat = 0
2953		End If
2954		End Function
2955
2956	<	Function raffinement_retrait_matiere(ByRef Eng As Double, ByRef Erx As Double)
2956	>	Sub raffinement_retrait_matiere(ByRef Eng As Double, ByRef Erx As Double, Optional ByRef limitepente As Double = 0.25)
2957		Dim cpt As Integer
2958		Dim coeff As Double
2959		Dim lmbd As Double
#	Line 2912 | Line 2961 | Module PoGCode
2961		Dim tmp() As Double
2962
2963		For cpt = 0 To UBound(Tabretrait_mat)
2964	<	If raffinn_auto_retrait_mat(Erx, coeff, lmbd, courb, Eng, Tabretrait_mat(cpt).diametre / 2, tmp) Then ChangeTabFace(Tabretrait_mat(cpt).face, coeff, lmbd, courb)
2964	>	If raffinn_auto_retrait_mat(Erx, coeff, lmbd, courb, Eng, Tabretrait_mat(cpt).diametre / 2, limitepente, tmp) Then ChangeTabFace(Tabretrait_mat(cpt).face, coeff, lmbd, courb)
2965		Next
2966
2967	<	End Function
2967	>	End Sub
2968
2969		End Module
2970

Diff Legend

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