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 47 by lacroix, Wed Aug 22 20:50:41 2007 UTC

#	Line 40 | Line 40 | Module PoGCode
40		'  -    Tous les points d'échantillonnage créés se retrouvent dans "tabpoint"
41		'       on écrit le fichier des points d'échantillonnage à partir de se tableau
42
43	<	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
43	>	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
44		Dim frequence As Integer
45		Dim vbody As Object
46		Dim grill As New grille
47		Dim Bbox() As Double
48		Dim path As String
49	–	Dim erx_rm As Double
49
50
51		Dim CMDialogl As New Windows.Forms.SaveFileDialog
#	Line 75 | Line 74 | Module PoGCode
74		initialisation()
75
76		'initialistation de la grille
77	<	Dim Coeffmax As Double = Math.Max(Math.Max(Arrondis, matiere), Math.Max(rentrant, Entities))
78	<	Dim taillecase As Double = Eng * (1 - Coeffmax)
77	>	Dim Coeffmin As Double = Math.Min(Math.Min(Arrondis, matiere), Math.Min(rentrant, Entities))
78	>	Dim taillecase As Double = Eng * (1 - Coeffmin)
79		Bbox = swbody.GetBodyBox
80		' on initialise la grille 0.5 pourcent supérieur à la bounding box
81		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 86 | Module PoGCode
86		End If
87		' Si la case retrait matiere est cochée
88		If matiereBool = True Then
89	<	erx_rm = determination_precision_retrait_mat(Eng, matiere)
91	<	raffinement_retrait_matiere(Eng, erx_rm)
92	<	'testretraitMatiere(Eng, erx_rm)
89	>	testretraitMatiere(matiere)
90		End If
91		' si la case rentrant est cochée
92		If rentrantBool = True Then
#	Line 124 | Line 121 | Module PoGCode
121		Next vbody
122
123		End Function
124	+
125	+	''' <summary>
126	+	''' Function POur traiter la préoptimisation de façon automatique
127	+	''' </summary>
128	+	''' <param name="Erx">Premier paramètre</param>
129	+	''' <param name="LimPT">youjhou</param>
130	+	''' <returns></returns>
131	+	''' <remarks></remarks>
132	+	Public Function DebutAutomatique(ByVal Erx As Double, ByVal LimPT As Double) As String
133	+
134	+	Dim vbody As Object
135	+	Dim grill As New grille
136	+	Dim Bbox() As Double
137	+	Dim path As String
138	+	Dim Eng As Double
139	+	Dim coef_min As Double
140	+	Erx = (100 - Erx) / 100 ' valeur d'erreur d'analyse exacte a priori
141	+
142	+
143	+	Dim CMDialogl As New Windows.Forms.SaveFileDialog
144	+	CMDialogl.DefaultExt = ".txt"
145	+	CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
146	+
147	+	CMDialogl.OverwritePrompt = True
148	+	CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
149	+	CMDialogl.ShowDialog()
150	+	path = CMDialogl.FileName
151	+	path = Txtpath(path)
152	+	If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!") : Return ""
153	+
154	+	vBodies = swPart.GetBodies2(SwConst.swBodyType_e.swAllBodies, True)
155	+	For Each vbody In vBodies
156	+	cpt = 0
157	+	Erase TabPoints
158	+	Erase Tabface
159	+	Erase TabFaceDouble
160	+	Erase TabEdge
161	+	Erase TabEdgeDouble
162	+
163	+	swbody = vbody
164	+	BoiteEnglobante()
165	+	initialisation()
166	+
167	+	'Calul de Eng
168	+	Eng = determination_ecart_nodal_global_retraits_mat(Erx, coef_min)
169	+
170	+
171	+	'initialistation de la grille
172	+
173	+	Dim taillecase As Double = Eng * (1 - coef_min)
174	+	Bbox = swbody.GetBodyBox
175	+	' on initialise la grille 0.5 pourcent supérieur à la bounding box
176	+	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))
177	+
178	+
179	+	raffinement_retrait_matiere(Eng, Erx, LimPT)
180	+
181	+
182	+	' on crée les points d'échantillonnage sur les sommets
183	+	CreerPointsVertex(Eng, grill)
184	+	' on crée les points d'échantillonnage sur les arêtes
185	+	CreerPointsEdge(Eng, grill)
186	+	' on crée les points d'échantillonnage sur les faces
187	+	CreerPointsFace(Eng, grill)
188	+
189	+
190	+	' on créée le fichier d'échantillonnage
191	+	fichiertxt(Eng, path)
192	+	swModel.ClearSelection2(True)
193	+	testPog(False, False, False, True, False)
194	+	Return path
195	+	Next vbody
196	+	End Function
197	+
198		Sub entitéselection(ByRef coeff As Double, ByRef Ind As Boolean)
199		Dim swSelMgr As SldWorks.SelectionMgr
200		Dim i As Integer
#	Line 370 | Line 441 | Module PoGCode
441		Next cpt1
442
443		End Sub
444	<	Sub testretraitMatiere(ByRef Eng As Double, ByRef erx As Double)
444	>	Sub testretraitMatiere(ByRef coeff As Double)
445
446		Dim swface As SldWorks.Face2
447		Dim swsurface As SldWorks.Surface
#	Line 380 | Line 451 | Module PoGCode
451		Dim cpt1 As Integer
452		Dim cpt2 As Integer
453		Dim swedge As SldWorks.Edge
383	–	Dim swedgetmp As SldWorks.Edge
454		Dim vedge As Object
455		Dim vface As Object
456		Dim cpt3 As Integer
387	–	Dim cpt4 As Integer
457		Dim i As Integer
458		Dim swent As SldWorks.Entity
459		Dim bRet As Boolean
460	<	Dim lmbd_rm As Integer
461	<	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
460	>	Dim lmbd_rm As Double = 4
461	>	Dim courb_rm As Double = 0
462
463		swfaceref = swbody.GetFirstFace
464	+
465		For cpt1 = 0 To swbody.GetFaceCount - 1
410	–	diametre = 0
466		swfeat = swfaceref.GetFeature
467		swsurface = swfaceref.GetSurface
468		swloop = swfaceref.GetFirstLoop
469		For cpt2 = 0 To swfaceref.GetLoopCount - 1
415	–	select_loop = 0
470		If swloop.IsOuter = False Then
471		vedge = swloop.GetEdges
472		For cpt3 = 0 To swloop.GetEdgeCount - 1
473		swedge = vedge(cpt3)
474		vface = swedge.GetTwoAdjacentFaces
475	<	swface = vface(0)
476	<	If swface.IsSame(swfaceref) = True Then swface = vface(1)
477	<	angle = GetAngle(swedge, swfaceref, swface)
478	<	If angle < 179 Then
479	<	If (select_loop = 0) Then
480	<
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)
475	>	For i = 0 To 1
476	>	swface = vface(i)
477	>	If swface.IsSame(swfaceref) = False Then
478	>	If GetAngle(swedge, swfaceref, swface) < 179 Then
479	>	ChangeTabFace(swface, coeff)
480	>	End If
481		End If
482	<	End If
482	>	Next i
483		Next cpt3
484		Else
485		If swfeat.GetTypeName = "HoleWzd" Then
486	<	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
486	>	ChangeTabFace(swfaceref, coeff)
487		Else
488	<	If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
489	<	diametre = 0
490	<	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)
488	>	If swfeat.GetFaceCount = 1 And swfeat.GetTypeName = "Cut" Then
489	>	If swsurface.Identity = 4002 Or swsurface.Identity = 4003 Or swsurface.Identity = 4005 Then
490	>	ChangeTabFace(swfaceref, coeff)
491		End If
492		End If
493		End If
#	Line 492 | Line 496 | Module PoGCode
496		Next cpt2
497		swfaceref = swfaceref.GetNextFace
498		Next cpt1
499	+
500		End Sub
501		Sub testAngleMatiere(ByRef coeff As Double)
502
#	Line 504 | Line 509 | Module PoGCode
509		Dim cpt1 As Integer
510		Dim Phi As Double
511		Dim swcurve As SldWorks.Curve
512	<	Dim lmbd_am As Integer
513	<	Dim courb_am As Double
514	<	lmbd_am = 6
510	<	courb_am = 2
512	>	Dim lmbd_am As Double = 4
513	>	Dim courb_am As Double = 0
514	>
515
516		vedge = swbody.GetEdges
517		' on test les arete et on prend celles qui sont des lignes
#	Line 1623 | Line 1627 | Module PoGCode
1627		swedge = TabEdge(cpt2)
1628		vEdgeU = swedge.GetCurveParams2
1629		longueur = GetEdgeLenght(swedge)
1630	<	pasmax = distance_entre_points(Eng, TabEdgeDouble(0, cpt2), TabEdgeDouble(1, cpt2), TabEdgeDouble(2, cpt2), 0.15)
1630	>	pasmax = distance_entre_points(Eng, TabEdgeDouble(0, cpt2), TabEdgeDouble(1, cpt2), TabEdgeDouble(2, cpt2), 0.5)
1631
1632		nbpas = 3 * Math.Max(2, Math.Floor(longueur / pasmax - 0.0001) + 1)
1633		pas = (vEdgeU(7) - vEdgeU(6)) / nbpas
#	Line 1709 | Line 1713 | Module PoGCode
1713		vSurfParam = swsurf.Parameterization
1714
1715		vUVlong = GetUVLong(swface)
1716	<	pasmax = distance_entre_points(Eng, TabFaceDouble(0, cpt3), TabFaceDouble(1, cpt3), TabFaceDouble(2, cpt3), 0.15)
1716	>	pasmax = distance_entre_points(Eng, TabFaceDouble(0, cpt3), TabFaceDouble(1, cpt3), TabFaceDouble(2, cpt3), 0.5)
1717
1718		nbpasU = 3 * Math.Max(2, Math.Floor(vUVlong(0) / pasmax - 0.0001) + 1)
1719		nbpasV = 3 * Math.Max(2, Math.Floor(vUVlong(1) / pasmax - 0.0001) + 1)
#	Line 2135 | Line 2139 | Module PoGCode
2139		End Sub
2140		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
2141		Dim rmax As Double
2142	+	Dim nor As Double = 0.5
2143	+	Dim eni As Double = eng * coef
2144	+	Dim enmax As Double = eng * coef * (1 + erreur)
2145
2139	–	If courbure <= 0 Then
2140	–	rmax = erreur
2141	–	End If
2146
2147	<	If courbure > 0 Then
2148	<	rmax = -0.05 * (Math.Sqrt(1 - 40 * courbure * erreur * (erreur - 1)) - 1) / ((erreur - 1) * courbure)
2145	<	End If
2147	>	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))
2148	>	If (courbure <= 0.0001) Then rmax = (enmax - eni) / (nor * (eng - enmax) - eni + enmax)
2149
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
2150
2151		Return 2 * rmax * lmbd * eng * (1 - coef)
2152
#	Line 2691 | Line 2691 | Module PoGCode
2691		End If
2692		direction_retrait_matiere = n
2693		End Function
2694	<	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
2694	>	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
2695		Dim delta_ref_theo As Double
2696		Dim delta_ref_ptlimite As Double
2697		Dim Eng_ref As Double
#	Line 2701 | Line 2701 | Module PoGCode
2701		Dim A As Double = 0.12
2702		Dim B As Double = 0.68
2703		Dim param_rm() As Double
2704	–	Dim pentelimite As Double = 0.25
2704
2705		Dim x As Double
2706		Dim pente As Double
#	Line 2760 | Line 2759 | Module PoGCode
2759		ReDim param(4)
2760		param(0) = A : param(1) = B : param(2) = C : param(3) = D
2761		End Function
2762	<	Function determination_precision_retrait_mat(ByRef Eng As Double, ByRef coeff_rm As Double) As Double
2762	>	Function determination_ecart_nodal_global_retraits_mat(ByRef Erx_m As Double, ByRef coeffmin As Double) As Double
2763
2764		Dim swface As SldWorks.Face2
2765		Dim swsurface As SldWorks.Surface
#	Line 2775 | Line 2774 | Module PoGCode
2774		Dim vface As Object
2775		Dim cpt3 As Integer
2776		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
2777		Dim lg As Double
2778		Dim lgi As Double
2779		Dim angle As Double
2780		Dim n(2) As Double
2781		Dim area As Double
2782		Dim select_loop As Integer
2789	–	Dim t As Double
2783		Dim diametre As Double = 0
2784		Dim nb_retrait_mat As Integer = 0
2785		Dim param(1) As Double
2786	<	Dim Eni_moy As Double = Eng * coeff_rm
2786	>	Dim Eng_moy As Double = 0
2787		Dim tmp() As Double
2788	+	Dim Eni As Double
2789
2790		ReDim Preserve Tabretrait_mat(0)
2791		Tabretrait_mat(0) = New retrait_mat(Nothing, 0)
#	Line 2827 | Line 2821 | Module PoGCode
2821		select_loop = 1
2822		End If
2823		If diametre > 0.000001 Then
2824	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2825	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2826	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swface, diametre)
2824	>	nb_retrait_mat = nb_retrait_mat + 1
2825	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2826	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swface, diametre)
2827	>	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2828	>	Eng_moy = Eng_moy + diametre / 2 * 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) puis multiplication par le rayon de la caractéristique (extrapolation)
2829	>	If Eni = 0 Then Eni = Eng_moy
2830	>	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
2831		End If
2832		End If
2833		Next cpt3
#	Line 2855 | Line 2853 | Module PoGCode
2853		MsgBox("Type de trou non reconnu")
2854		End Select
2855		If diametre > 0.000001 Then
2856	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2857	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2858	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)
2859	<
2856	>	nb_retrait_mat = nb_retrait_mat + 1
2857	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2858	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swfaceref, diametre)
2859	>	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2860	>	Eng_moy = Eng_moy + diametre / 2 * 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) puis multiplication par le rayon de la caractéristique (extrapolation)
2861	>	If Eni = 0 Then Eni = Eng_moy
2862	>	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
2863		End If
2864		Else
2865		If swfeat.GetFaceCount = 1 And (swfeat.GetTypeName = "Cut" Or swfeat.GetTypeName = "RevCut") Then
#	Line 2877 | Line 2878 | Module PoGCode
2878		diametre = params(7) * 2
2879		End If
2880		If diametre > 0.000001 Then
2881	<	If Tabretrait_mat(0).diametre > 0 Then nb_retrait_mat = nb_retrait_mat + 1
2882	<	ReDim Preserve Tabretrait_mat(nb_retrait_mat)
2883	<	Tabretrait_mat(nb_retrait_mat) = New retrait_mat(swfaceref, diametre)
2881	>	nb_retrait_mat = nb_retrait_mat + 1
2882	>	ReDim Preserve Tabretrait_mat(nb_retrait_mat - 1)
2883	>	Tabretrait_mat(nb_retrait_mat - 1) = New retrait_mat(swfaceref, diametre)
2884	>	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2885	>	Eng_moy = Eng_moy + diametre / 2 * 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) puis multiplication par le rayon de la caractéristique (extrapolation)
2886	>	If Eni = 0 Then Eni = Eng_moy
2887	>	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
2888		End If
2889		End If
2890		End If
#	Line 2890 | Line 2895 | Module PoGCode
2895		Next cpt1
2896
2897		If nb_retrait_mat > 0 Or Tabretrait_mat(0).diametre > 0 Then
2898	<	diametre = 0
2899	<	For cpt1 = 0 To nb_retrait_mat
2900	<	diametre = diametre + Tabretrait_mat(cpt1).diametre
2901	<	Next
2902	<	diametre = diametre / (nb_retrait_mat + 1)
2898	<	Eni_moy = 2 * Eni_moy / diametre  ' devient Eni moy reference
2899	<	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, param)
2900	<	determination_precision_retrait_mat = Eni_moy * param(0) * Math.Pow(contrainte_vm_rm_ref(0, 2, tmp), param(1))
2901	<	MsgBox("Pré-optimisation de maillage des caractéristiques Retraits de matière avec une précision de " & 100 * determination_precision_retrait_mat & "%")
2898	>	Eng_moy = Eng_moy / nb_retrait_mat
2899	>	raffinn_auto_retrait_mat(0, 0, 0, 0, 0, 0, 0, param)
2900	>	determination_ecart_nodal_global_retraits_mat = Eng_moy
2901	>	coeffmin = Eni / Eng_moy
2902	>	'MsgBox("Pré-optimisation de maillage des caractéristiques Retraits de matière avec une écart nodal global de " & 1000 * Eng_moy & "mm")
2903		Else
2904	<	determination_precision_retrait_mat = 1
2904	>	determination_ecart_nodal_global_retraits_mat = 0
2905		End If
2906		End Function
2907
2908	<	Function raffinement_retrait_matiere(ByRef Eng As Double, ByRef Erx As Double)
2908	>	Sub raffinement_retrait_matiere(ByRef Eng As Double, ByRef Erx As Double, Optional ByRef limitepente As Double = 0.25)
2909		Dim cpt As Integer
2910		Dim coeff As Double
2911		Dim lmbd As Double
#	Line 2912 | Line 2913 | Module PoGCode
2913		Dim tmp() As Double
2914
2915		For cpt = 0 To UBound(Tabretrait_mat)
2916	<	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)
2916	>	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)
2917		Next
2918
2919	<	End Function
2919	>	End Sub
2920
2921		End Module
2922

Diff Legend

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