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

Diff Legend

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