ViewVC Help

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

root/REPOS_ERICCA/magicsld/Intersections.vb

Comparing magicsld/Intersections.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 SolidWorks.Interop
2	+	Imports SolidWorks.Interop.swconst
3	+	Imports SolidWorks.Interop.swpublished
4	+
5		Module Intersections
6		Public DefAttrInterALAL As SldWorks.AttributeDef
7		Public DefAttrConditionLimite As SldWorks.AttributeDef
#	Line 9 | Line 13 | Module Intersections
13
14		Public nbMinipoutre As Long
15
16	+	Public lst_InterCoqueCoque As New Collections.Generic.List(Of InterCoqueCoque)
17
18	+	Public MettreMiniPoutresSurFaceInternes As Boolean
19	+	Public MultiDecoupageCoques As Boolean = False
20
21		#Region "Enums"
22		Public Enum typeInterPoutreVolume
#	Line 27 | Line 34 | Module Intersections
34		' *******
35		' quelques options de performance
36		' *******
37	<	swApp.SetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
37	>	swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
38		swModel.SetAddToDB(True)
39		swModel.SetDisplayWhenAdded(False)
40	+	swModel.SetInferenceMode(False)
41		' ******
42		' fin des options de performance
43		' ******
44
45		Memoriser3iemePoint() ' mémorise le coord system car si on découpe, sa coordonnée est perdue.
46	+
47		CouperPoutres()
48		Commun.GenererListes() ' va ignorer les poutres à ignorer... et ajouter les poutres coupées dans la liste.
49
50
51
52		' Traitement des intersection poutres-Volumes
53	<	DetectionPoutresVolumes()
53	>	DetectionPoutresVolumes() ' doit être avant interpoutreCoque au cas où on aurait une poutre de section
54		DecouperPoutreVolume()
55		' fin traitement intersection poutres-volumes
56
#	Line 62 | Line 71 | Module Intersections
71
72		' traitement des coques-coques
73		DetectionCoqueCoque()
74	<
74	>	DecouperCoqueCoque()
75		'
76
77
#	Line 70 | Line 79 | Module Intersections
79		' *******
80		' quelques options de performance, remettre à la position initiale
81		' *******
82	<	swApp.SetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
82	>	swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
83		swModel.SetAddToDB(False)
84		swModel.SetDisplayWhenAdded(True)
85		swModel.GraphicsRedraw2()
86	+	swModel.SetInferenceMode(True)
87		' ******
88		' fin des options de performance
89		' ******
#	Line 84 | Line 94 | Module Intersections
94
95
96		''' <summary>
97	+	''' Sub qui découpe les coques en fonction des informations placées dans le InterCoqueCoque
98	+	''' </summary>
99	+	''' <remarks></remarks>
100	+	Private Sub DecouperCoqueCoque()
101	+	Dim rayon As Double
102	+
103	+	For Each interCC As InterCoqueCoque In lst_InterCoqueCoque
104	+	'rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
105	+
106	+	If interCC.DoitCouperCoque1 Then
107	+	rayon = interCC.sFaceCoque2.GetEpaisseur / 2
108	+	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
109	+	interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
110	+	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
111	+	End If
112	+
113	+	If interCC.DoitCouperCoque2 Then
114	+	rayon = interCC.sFaceCoque1.GetEpaisseur / 2
115	+	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
116	+	interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
117	+	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
118	+	End If
119	+
120	+	If interCC.FaceAPlat Then
121	+	interCC.CoupeAPlat()
122	+	End If
123	+
124	+	' reste à retrouver les faces internes.
125	+	'interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
126	+	Next
127	+
128	+
129	+	End Sub
130	+
131	+	'Private Sub DecouperCoqueCoque()
132	+	'    Dim rayon As Double
133	+
134	+
135	+	'    For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
136	+	'        For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
137	+	'            rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
138	+	'            Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
139	+	'            interCC.DecouperCoque(Coque, sweep)
140	+
141	+	'            ' reste à retrouver les faces internes.
142	+	'            interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
143	+	'        Next
144	+	'    Next
145	+
146	+
147	+	'End Sub
148	+
149	+
150	+
151	+	''' <summary>
152		'''  sub qui créé une instance de la classe interCoqueCoque s'il y a une intersection de ce type
153		''' </summary>
154		''' <remarks></remarks>
#	Line 91 | Line 156 | Module Intersections
156
157		Dim sketch As SldWorks.Sketch = Nothing
158		Dim interCC As InterCoqueCoque = Nothing
159	+	Dim Coque1 As SlyFaceCoque, Coque2 As SlyFaceCoque
160
161	<	For Each Coque1 As SlyFaceCoque In Commun.lst_FaceCoque
162	<	For Each coque2 As SlyFaceCoque In lst_FaceCoque
163	<
164	<	If DetectFaceFace(coque2.SwFace, Coque1.SwFace, True, sketch) Then
161	>	For i As Integer = 0 To Commun.lst_FaceCoque.Count - 2 'For Each Coque1 As SlyFaceCoque In Commun.lst_FaceCoque
162	>	Coque1 = Commun.lst_FaceCoque.Item(i)
163	>	For j As Integer = i + 1 To Commun.lst_FaceCoque.Count - 1 '  For Each coque2 As SlyFaceCoque In lst_FaceCoque
164	>	Coque2 = Commun.lst_FaceCoque.Item(j)
165	>	If DetectFaceFace(Coque2.SwFace, Coque1.SwFace, True, sketch) Then
166		' création de l'instance de interFace-face entre coque et coque
167
168	<	interCC = New InterCoqueCoque
102	<	interCC.sFaceCoque1 = Coque1
103	<	interCC.sFaceCoque2 = coque2
168	>	interCC = New InterCoqueCoque(Coque1, Coque2)
169		interCC.FaceDeSection = False
170		interCC.sketch = sketch
171	+	interCC.determineType()
172	+	lst_InterCoqueCoque.Add(interCC)
173
174	<	Coque1.lst_InterCoqueCoque.Add(interCC)
175	<	coque2.lst_InterCoqueCoque.Add(interCC)
174	>	'Coque1.lst_InterCoqueCoque.Add(interCC)
175	>	'Coque2.lst_InterCoqueCoque.Add(interCC)
176		End If
177
178	<
179	<	Next
113	<	Next
178	>	Next j
179	>	Next i
180
181		End Sub
182
#	Line 160 | Line 226 | Module Intersections
226
227		nom = "InterALAL"
228		DefAttrInterALAL = swApp.DefineAttribute(nom)
229	<	DefAttrInterALAL.AddParameter("X", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
230	<	DefAttrInterALAL.AddParameter("Y", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
231	<	DefAttrInterALAL.AddParameter("Z", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
232	<	DefAttrInterALAL.AddParameter("T", SwConst.swParamType_e.swParamTypeDouble, -1, 0)
229	>	DefAttrInterALAL.AddParameter("X", swconst.swParamType_e.swParamTypeDouble, 0, 0)
230	>	DefAttrInterALAL.AddParameter("Y", swconst.swParamType_e.swParamTypeDouble, 0, 0)
231	>	DefAttrInterALAL.AddParameter("Z", swconst.swParamType_e.swParamTypeDouble, 0, 0)
232	>	DefAttrInterALAL.AddParameter("T", swconst.swParamType_e.swParamTypeDouble, -1, 0)
233		retval = DefAttrInterALAL.Register()
234		If retval = False Then MsgBox("Enregistrement raté pour le InterALAL")
235
236
237		nom = "ConditionLimite"
238		DefAttrConditionLimite = swApp.DefineAttribute(nom)
239	<	DefAttrConditionLimite.AddParameter("CL", SwConst.swParamType_e.swParamTypeString, 0, 0)
239	>	DefAttrConditionLimite.AddParameter("CL", swconst.swParamType_e.swParamTypeString, 0, 0)
240		retval = DefAttrConditionLimite.Register()
241		If retval = False Then MsgBox("Enregistrement raté pour le COndition Limite")
242
#	Line 192 | Line 258 | Module Intersections
258		DefAttrRCP1.AddParameter("D5", 0, 0, 0)
259		DefAttrRCP1.AddParameter("D6", 0, 0, 0)
260		DefAttrRCP1.AddParameter("Flag", 0, 0, 0)
195	–
261		retval = DefAttrRCP1.Register()
262		If retval = False Then MsgBox("Enregistrement raté pour le RCPoutre")
263
#	Line 204 | Line 269 | Module Intersections
269		If retval = False Then MsgBox("Enregistrement raté pour le RCCoque")
270
271		DefAttrFaceInterne = swApp.DefineAttribute("FaceInterne")
272	<	DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la présence de l'attribut est suffisante.
272	>	DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la taille des éléments
273	>	DefAttrFaceInterne.AddParameter("Po", 0, 0, 0)  ' =0 si poutre, =1 si coque
274		retval = DefAttrFaceInterne.Register()
275		If retval = False Then MsgBox("Enregistrement raté pour le FaceInterne")
276
#	Line 512 | Line 578 | Module Intersections
578
579		If sPoutre.Evaluer(T1, PointTest) Then
580		' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
581	<	If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
581	>	If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
582		' on est dans la coque.
583		If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
584		End If
#	Line 655 | Line 721 | Module Intersections
721		' 1 - Spotter la ou les faces en question
722		xyz = sPoutre.GetStartPoint
723		xyz2 = sPoutre.GetEndPoint
724	+
725		For Each sVol In Commun.lst_FaceVolume
726		If Intersections.DetectSurfaceArete(sPoutre.swArete, sVol.SwFace, Nothing) Then
727		swModel.ClearSelection2(True)
728		sVol.Selectionner()
729		section = swExt.GetSectionProperties2(sVol.SwFace) : proprietes = section
730		swModel.ClearSelection2(True)
731	<	' la fontion getsectionproperties renvoie des valeurs dont la précision est très douteuse...
731	>	' la fonction getsectionproperties renvoie des valeurs dont la précision est très douteuse...
732		' on met alors une beaucoup plus grosse tolérance...
733	<	If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then Face1 = sVol : prop1 = proprietes
734	<	If Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then Face2 = sVol : prop2 = proprietes
733	>	If Math.Abs(xyz(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz(2) - proprietes(4)) < 0.0001 Then
734	>	Face1 = sVol : prop1 = proprietes
735	>	ElseIf Math.Abs(xyz2(0) - proprietes(2)) < 0.0001 And Math.Abs(xyz2(1) - proprietes(3)) < 0.0001 And Math.Abs(xyz2(2) - proprietes(4)) < 0.0001 Then
736	>	Face2 = sVol : prop2 = proprietes
737	>	Else
738	>	' on a une intersection où la poutre touche à une face «guide» et une autre partie touche à une face normale
739	>	' la face est automatiquement une face de volume.  Si c'est une coque, elle est traitée ailleurs.
740	>
741	>	'Dim interNormale As InterPoutreVolume
742	>	'Dim point1 As Object = Nothing
743	>	'swModel.ClosestDistance(sPoutre.swArete, sVol.SwFace, point1, Nothing)
744	>	'Dim xyzNormale() As Double = point1
745	>	'interNormale = sVol.AjouterInterPoutre(sPoutre, xyzNormale, 6) ' y'a des cas où ça pourrait ne pas être 1...
746	>	'sPoutre.lst_InterCoque.Add(interNormale)
747	>
748	>	End If
749	>
750		End If
751		Next
752
#	Line 674 | Line 756 | Module Intersections
756		Dim e As New SuperArete(sPoutre.swArete, True)
757		e.Colorer(3, 1, 0, 0)
758		sPoutre.Selectionner()
759	+	Err.Raise(520, "Gestion_Face_De_Section", "Une poutre ne peut être traitée car elle n'a pas été correctement définie.")
760		Exit Sub
761		End If
762
#	Line 694 | Line 777 | Module Intersections
777		' 2.2 le centroide est au point d'intersection
778		' déjà fait
779		' 2.3 la face est plane
780	+	Dim prop() As Double = Nothing
781	+
782		If Face1 IsNot Nothing Then
783	+	prop = prop1
784		If Not (Face1.estPlan Xor Face1.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
785		MsgBox("La face 1 n'est pas plane!")
786		Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
787		End If
788		End If
789		If Face2 IsNot Nothing Then
790	<	If Not (Face2.estPlan Xor Face2.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
790	>	prop = prop2
791	>	If Not (Face2.estPlan Xor Face2.estFauxPlan(prop2(2), prop2(3), prop2(4))) Then
792		MsgBox("La face 2 n'est pas plane!")
793		Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
794		End If
#	Line 735 | Line 822 | Module Intersections
822		' 3 - trouver l'inertie et l'aire, placer le point 3 de façon cohérente, updater l'attribut.
823		Dim Nom3 As String
824
825	<	Commun.MettreUnPoint(prop1(2) + prop1(18) / 1000, prop1(3) + prop1(19) / 1000, prop1(4) + prop1(20) / 1000, True)
826	<	Nom3 = RealConstant.RCCode.Creation3iemePoint(1)
827	<	sPoutre.SetAttributsDePoutre(False, Nom3, , , prop1(13), prop1(14), prop1(1), , , , , , , 1)
825	>	Commun.MettreUnPoint(prop(2) + prop(18) / 1000, prop(3) + prop(19) / 1000, prop(4) + prop(20) / 1000, True)
826	>	Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
827	>	Nom3 = RealConstant.RCCode.Creation3iemePoint(selmgr.GetSelectedObject(1))
828	>	sPoutre.SetAttributsDePoutre(False, Nom3, , , prop(13), prop(14), prop(1), , , , , , , 1)
829
830		' 4 créer une nouvelle instance de la classe interFacePoutre de tipe 5
831		Dim inter As New InterPoutreVolume
#	Line 769 | Line 857 | Module Intersections
857		Dim i As Integer
858		Dim premier2 As Boolean
859		Dim sVol As SlyFaceVolume
860	+	Dim SurSurface As Boolean = False
861
862		For Each sVol In lst_FaceVolume
863
775	–
864		' on cherche entre la coque et la poutre
865	<
866	<
779	<
780	<	If DetectFaceArete(sPoutre.swArete, sVol, xyz) Then
781	<
865	>	SurSurface = False
866	>	If DetectFaceArete(sPoutre.swArete, sVol, xyz, SurSurface) Then
867		For i = 0 To UBound(xyz) - 1 Step 3
868		' trouver le tipe d'intersection...
869
#	Line 800 | Line 885 | Module Intersections
885		T1 = T + 15 * Epsilon
886		T2 = T - 15 * Epsilon
887
803	–	Dim effacer As Double
888
889		If sPoutre.Evaluer(T1, PointTest) Then
890		' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
#	Line 811 | Line 895 | Module Intersections
895		End If
896
897		If sPoutre.Evaluer(T2, PointTest) Then
898	<	effacer = Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2))
898	>
899		If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
900		If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
901		End If
#	Line 830 | Line 914 | Module Intersections
914
915		Next i ' autre point d'intersection
916
917	+	ElseIf SurSurface = True Then
918	+	' Si les 2 points de la courbe touchent à la surface alors  coupe-long
919	+	If Commun.Distance(sVol.SwFace, sPoutre.GetStartPoint()) < Epsilon AndAlso Commun.Distance(sVol.SwFace, sPoutre.GetEndPoint()) < Epsilon Then
920	+	inter = sVol.AjouterInterPoutre(sPoutre, xyz, 2)
921	+	sPoutre.lst_InterCoque.Add(inter)
922	+	End If
923		End If
924		premier2 = False ' reset
925
#	Line 949 | Line 1039 | Module Intersections
1039		' function qui détecte si une arête coupe une face, si c'est le cas la function retourne true et remplie le tableau xyz avec le point d'intersection
1040
1041		Dim P1 As Object = Nothing, p2 As Object = Nothing
1042	<	If swModel.ClosestDistance(swArete, swFace, P1, P2) > Epsilon Then Return False
1042	>	If swModel.ClosestDistance(swArete, swFace, P1, p2) > Epsilon Then Return False
1043
1044		Dim swCurve As SldWorks.Curve
1045		Dim swSurf As SldWorks.Surface
#	Line 1057 | Line 1147 | Module Intersections
1147
1148
1149
1150	<	Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double) As Boolean
1151	<	Dim swface As SldWorks.Face2
1152	<	Dim surarete As Boolean
1150	>	Private Function DetectFaceArete(ByRef swArete As sldworks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double, Optional ByRef SurSurface As Boolean = False) As Boolean
1151	>	Dim swface As sldworks.Face2
1152	>
1153		For Each swface In Slyface.lst_Faces
1154		If DetectFaceArete(swArete, swface, xyz) Then
1155		Dim vEdges As Object
1156	<	Dim Arete As SldWorks.Edge
1156	>	Dim Arete As sldworks.Edge
1157		Dim inu() As Double = Nothing
1158
1159		vEdges = swface.GetEdges
#	Line 1071 | Line 1161 | Module Intersections
1161		For Each Arete In vEdges
1162		If DetectAreteArete(Arete, swArete, inu) Then
1163		' on a un type d'intersection entre une face et une arète...
1164	<	Dim swSurf As SldWorks.Surface
1164	>	Dim swSurf As sldworks.Surface
1165		Dim retval As Object
1166		Dim v(2) As Double
1167		Dim u(2) As Double
#	Line 1085 | Line 1175 | Module Intersections
1175		retval = swArete.Evaluate(retval(0))
1176		u(0) = retval(3) : u(1) = retval(4) : u(2) = retval(5)
1177		angle = Outils_Math.Angle2Vecteurs(u, v)
1178	<	MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense)
1178	>	'MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense & vbCr & "Aire = " & Slyface.Aire)
1179
1180	<	If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1181	<	Return True
1180	>
1181	>	'Si l'angle entre la normale de la face et la normale de la courbe est de 0
1182	>	' ou de pi/2 alors on a une SurSurface
1183	>	If Math.Abs(angle - Pi / 2) < 100 * Epsilon Or Math.Abs(angle) < 100 * Epsilon Then
1184	>	SurSurface = True
1185		Else
1186	<	surarete = True
1186	>	Return True
1187		End If
1188	+
1189	+	'If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1190	+	'    Return True
1191	+	'Else
1192	+	'    SurSurface = True
1193	+	'End If
1194		End If
1195		Next
1196
1197
1198	<	If Not surarete Then Return True Else Return False
1198	>	If Not SurSurface Then Return True Else Return False
1199		End If
1200		Next
1201		End Function
#	Line 1355 | Line 1454 | Module Intersections
1454		Dim a1 As Integer
1455		Dim a2 As Integer
1456
1457	+	Try
1458	+	For a1 = 0 To lst_AretePoutre.Count - 1
1459	+	SlyArete1 = lst_AretePoutre.Item(a1)
1460	+	swArete1 = SlyArete1.swArete
1461	+
1462	+	If Not a1 = lst_AretePoutre.Count - 1 Then
1463	+	For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1464	+	SlyArete2 = lst_AretePoutre.Item(a2)
1465	+	swArete2 = SlyArete2.swArete
1466	+
1467	+	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1468	+	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1469	+
1470	+	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1471	+	Case 1 ' la première courbe est coupée
1472	+	pt = New InterPoutrePoutre
1473	+	pt.Arete = swArete1
1474	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1475	+	SlyArete1.AjouterPointAPAP(pt)
1476	+	pt = Nothing
1477	+	Case 2 ' la seconde courbe est coupée
1478	+	pt = New InterPoutrePoutre
1479	+	pt.Arete = swArete2
1480	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1481	+	SlyArete2.AjouterPointAPAP(pt)
1482	+	pt = Nothing
1483	+	Case 3 ' les doux poutres sont coupées
1484	+	pt = New InterPoutrePoutre
1485	+	pt.Arete = swArete1
1486	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1487	+	SlyArete1.AjouterPointAPAP(pt)
1488	+	pt = Nothing
1489	+	pt = New InterPoutrePoutre
1490	+	pt.Arete = swArete2
1491	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1492	+	SlyArete2.AjouterPointAPAP(pt)
1493	+	pt = Nothing
1494	+	End Select
1495	+	Next i
1496	+	End If
1497
1498	<	For a1 = 0 To lst_AretePoutre.Count - 2
1360	<	SlyArete1 = lst_AretePoutre.Item(a1)
1361	<	swArete1 = SlyArete1.swArete
1362	<
1363	<	For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1364	<	SlyArete2 = lst_AretePoutre.Item(a2)
1365	<	swArete2 = SlyArete2.swArete
1366	<
1367	<	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1368	<	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1369	<
1370	<	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1371	<	Case 1 ' la première courbe est coupée
1372	<	pt = New InterPoutrePoutre
1373	<	pt.Arete = swArete1
1374	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1375	<	SlyArete1.AjouterPointAPAP(pt)
1376	<	pt = Nothing
1377	<	Case 2 ' la seconde courbe est coupée
1378	<	pt = New InterPoutrePoutre
1379	<	pt.Arete = swArete2
1380	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1381	<	SlyArete2.AjouterPointAPAP(pt)
1382	<	pt = Nothing
1383	<	Case 3 ' les doux poutres sont coupées
1384	<	pt = New InterPoutrePoutre
1385	<	pt.Arete = swArete1
1386	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1387	<	SlyArete1.AjouterPointAPAP(pt)
1388	<	pt = Nothing
1389	<	pt = New InterPoutrePoutre
1390	<	pt.Arete = swArete2
1391	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1392	<	SlyArete2.AjouterPointAPAP(pt)
1393	<	pt = Nothing
1394	<	End Select
1395	<	Next i
1498	>	Next a2
1499		End If
1500
1501	<	Next a2
1502	<
1503	<	Dim SlyArete3 As SlyAreteCoque
1504	<	For a2 = 0 To lst_AreteCoque.Count - 1
1505	<	SlyArete3 = lst_AreteCoque.Item(a2)
1506	<	swArete2 = SlyArete3.swArete
1507	<
1508	<	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1509	<	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1510	<
1511	<	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1512	<	Case 1 ' la première courbe est coupée
1513	<	pt = New InterPoutrePoutre
1514	<	pt.Arete = swArete1
1515	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1516	<	SlyArete1.AjouterPointAPAP(pt)
1517	<	pt = Nothing
1518	<	' seul la coque est coupée, elle sera découpée anyway.
1519	<	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1520	<	pt = New InterPoutrePoutre
1521	<	pt.Arete = swArete1
1522	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1523	<	SlyArete1.AjouterPointAPAP(pt)
1524	<	pt = Nothing
1525	<	End Select
1526	<	Next i
1424	<	End If
1425	<	Next a2
1501	>	Dim SlyArete3 As SlyAreteCoque
1502	>	For a2 = 0 To lst_AreteCoque.Count - 1
1503	>	SlyArete3 = lst_AreteCoque.Item(a2)
1504	>	swArete2 = SlyArete3.swArete
1505	>
1506	>	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1507	>	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1508	>
1509	>	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1510	>	Case 1 ' la première courbe est coupée
1511	>	pt = New InterPoutrePoutre
1512	>	pt.Arete = swArete1
1513	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1514	>	SlyArete1.AjouterPointAPAP(pt)
1515	>	pt = Nothing
1516	>	' seul la coque est coupée, elle sera découpée anyway.
1517	>	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1518	>	pt = New InterPoutrePoutre
1519	>	pt.Arete = swArete1
1520	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1521	>	SlyArete1.AjouterPointAPAP(pt)
1522	>	pt = Nothing
1523	>	End Select
1524	>	Next i
1525	>	End If
1526	>	Next a2
1527
1528	<	Dim slyarete4 As SlyAreteVol
1529	<	For a2 = 0 To lst_AreteVolume.Count - 1
1530	<	slyarete4 = lst_AreteVolume.Item(a2)
1531	<	swArete2 = slyarete4.swArete
1528	>	Dim slyarete4 As SlyAreteVol
1529	>	For a2 = 0 To lst_AreteVolume.Count - 1
1530	>	slyarete4 = lst_AreteVolume.Item(a2)
1531	>	swArete2 = slyarete4.swArete
1532	>
1533	>	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1534	>	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1535	>
1536	>	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1537	>	Case 1 ' la première courbe est coupée
1538	>	pt = New InterPoutrePoutre
1539	>	pt.Arete = swArete1
1540	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1541	>	SlyArete1.AjouterPointAPAP(pt)
1542	>	pt = Nothing
1543	>	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1544	>	pt = New InterPoutrePoutre
1545	>	pt.Arete = swArete1
1546	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1547	>	SlyArete1.AjouterPointAPAP(pt)
1548	>	pt = Nothing
1549	>	End Select
1550	>	Next i
1551	>	End If
1552	>	Next a2
1553
1432	–	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1433	–	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1554
1435	–	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1436	–	Case 1 ' la première courbe est coupée
1437	–	pt = New InterPoutrePoutre
1438	–	pt.Arete = swArete1
1439	–	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1440	–	SlyArete1.AjouterPointAPAP(pt)
1441	–	pt = Nothing
1442	–	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1443	–	pt = New InterPoutrePoutre
1444	–	pt.Arete = swArete1
1445	–	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1446	–	SlyArete1.AjouterPointAPAP(pt)
1447	–	pt = Nothing
1448	–	End Select
1449	–	Next i
1450	–	End If
1451	–	Next a2
1555
1556	+	Next a1
1557	+	pt = Nothing
1558
1559	+	Catch
1560	+	MsgBox(" La première boucle n'a pas marchée")
1561	+	End Try
1562
1455	–	Next a1
1456	–	pt = Nothing
1563
1564	+	Dim count As Long = 0, count2 As Long = 0
1565	+	Try
1566
1567	+	'toutes les poutres ont des points où elles doivent être coupées
1568	+	' il suffit de couper.
1569	+	' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1570	+	Dim attr As sldworks.Attribute
1571	+	Dim swEnt As sldworks.Entity
1572	+
1573	+	For Each SlyArete1 In lst_AretePoutre
1574	+	If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1575	+	'1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1576	+
1577	+	count += 1
1578	+	' si c'est une droite
1579	+	If SlyArete1.IsLine Then
1580	+	Dim Pts(,) As Double
1581	+	Dim swSketch As sldworks.Sketch
1582	+	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1583	+
1584	+	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1585	+	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1586	+
1587	+	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1588	+	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1589	+	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1590	+	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1591	+	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1592	+	Next i
1593	+
1594	+	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1595	+	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1596	+	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1597	+
1598	+	' faut ordonner les points selon T...
1599	+	Dim j As Integer
1600	+	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1601	+	For i = 0 To max - 2
1602	+	For j = 0 To max - i - 1
1603	+	If Pts(3, j) > Pts(3, j + 1) Then
1604	+	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1605	+	Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1606	+	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1607	+	End If
1608	+	Next j
1609	+	Next i
1610
1460	–	'toutes les poutres ont des points où elles doivent être coupées
1461	–	' il suffit de couper.
1462	–	' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1463	–	Dim attr As SldWorks.Attribute
1464	–	Dim swEnt As SldWorks.Entity
1611
1612	<	For Each SlyArete1 In lst_AretePoutre
1613	<	If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1614	<	'1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1615	<
1616	<
1617	<	' si c'est une droite
1618	<	If SlyArete1.IsLine Then
1619	<	Dim Pts(,) As Double
1620	<	Dim swSketch As SldWorks.Sketch
1621	<	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1622	<
1623	<	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1624	<	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1625	<
1626	<	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1627	<	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1628	<	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1629	<	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1630	<	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1631	<	Next i
1612	>	For i = 0 To UBound(Pts, 2) - 1
1613	>	swModel.Insert3DSketch2(False)
1614	>	swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
1615	>	swSketch = swModel.GetActiveSketch2
1616	>	swModel.Insert3DSketch2(False)
1617	>
1618	>	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1619	>	swModel.InsertCompositeCurve()
1620	>	Try
1621	>	count2 += 1
1622	>	UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1623	>	Catch
1624	>	MsgBox("UpdateAttribut n'a pas marché au compte # " & count2)
1625	>	End Try
1626	>	Next i
1627	>
1628	>
1629	>	Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1630	>
1631	>	Dim Pts(,) As Double
1632	>	Dim swSketch As sldworks.Sketch
1633	>	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1634	>
1635	>	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1636	>	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1637	>
1638	>	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1639	>	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1640	>	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1641	>	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1642	>	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1643	>	Next i
1644	>
1645	>	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1646	>	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1647	>	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1648	>
1649	>	' faut ordonner les points selon T...
1650	>	Dim j As Integer
1651	>	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1652	>	For i = 0 To max - 2
1653	>	For j = 0 To max - i - 1
1654	>	If Pts(3, j) > Pts(3, j + 1) Then
1655	>	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1656	>	Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1657	>	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1658	>	End If
1659	>	Next j
1660	>	Next i
1661
1662	<	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1663	<	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1664	<	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1665	<
1666	<	' faut ordonner les points selon T...
1667	<	Dim j As Integer
1668	<	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1669	<	For i = 0 To max - 2
1670	<	For j = 0 To max - i - 1
1671	<	If Pts(3, j) > Pts(3, j + 1) Then
1672	<	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1673	<	Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1674	<	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1662	>	Dim skSeg As sldworks.SketchSegment
1663	>	Dim x As Double, y As Double, z As Double
1664	>	Dim vretval As Object
1665	>	Dim useEdge As sldworks.SketchSegment
1666	>	Dim m As Integer
1667	>
1668	>
1669	>	For i = 0 To UBound(Pts, 2) - 1
1670	>	swModel.Insert3DSketch2(False)
1671	>	' sélectionner la edge originale
1672	>	swEnt = SlyArete1.swArete
1673	>	swEnt.Select4(False, Nothing)
1674	>	swModel.SketchUseEdge2(False)
1675	>	swSketch = swModel.GetActiveSketch2()
1676	>
1677	>	' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
1678	>	If i <> 0 Then ' premier pick, élimine ce qui est avant.
1679	>	skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01)    'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
1680	>	skSeg.ConstructionGeometry = True ' ligne de construction
1681	>	swModel.ClearSelection2(True)
1682	>	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1683	>	SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1684	>	vretval = swSketch.GetSketchSegments
1685	>	useEdge = vretval(0) : m = 0
1686	>	Do Until useEdge.ConstructionGeometry = False
1687	>	m += 1
1688	>	useEdge = vretval(m)
1689	>	Loop
1690	>	useEdge.Select4(False, Nothing)
1691	>	swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1692	>	skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1693	>	skSeg.ConstructionGeometry = True
1694		End If
1501	–	Next j
1502	–	Next i
1503	–
1504	–
1505	–	For i = 0 To UBound(Pts, 2) - 1
1506	–	swModel.Insert3DSketch2(False)
1507	–	swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1)) ' et pour chaque segment
1508	–	swSketch = swModel.GetActiveSketch2
1509	–	swModel.Insert3DSketch2(False)
1510	–
1511	–	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1512	–	swModel.InsertCompositeCurve()
1695
1696	<	UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1697	<	Next i
1698	<
1699	<
1700	<	Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1701	<
1702	<	Dim Pts(,) As Double
1703	<	Dim swSketch As SldWorks.Sketch
1704	<	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1705	<
1706	<	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1707	<	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1708	<
1709	<	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1710	<	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1711	<	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1712	<	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1713	<	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1532	<	Next i
1533	<
1534	<	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1535	<	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1536	<	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1537	<
1538	<	' faut ordonner les points selon T...
1539	<	Dim j As Integer
1540	<	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1541	<	For i = 0 To max - 2
1542	<	For j = 0 To max - i - 1
1543	<	If Pts(3, j) > Pts(3, j + 1) Then
1544	<	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1545	<	Pts(0, j) = Pts(0, j + 1) : Pts(1, j) = Pts(1, j + 1) : Pts(2, j) = Pts(2, j + 1) : Pts(3, j) = Pts(3, j + 1)
1546	<	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1696	>	If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1697	>	skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
1698	>	skSeg.ConstructionGeometry = True ' ligne de construction
1699	>	swModel.ClearSelection2(True)
1700	>
1701	>	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1702	>	SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1703	>	vretval = swSketch.GetSketchSegments
1704	>	useEdge = vretval(0) : m = 0
1705	>	Do Until useEdge.ConstructionGeometry = False
1706	>	m += 1
1707	>	useEdge = vretval(m)
1708	>	Loop
1709	>
1710	>	useEdge.Select4(False, Nothing)
1711	>	swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1712	>	skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1713	>	skSeg.ConstructionGeometry = True
1714		End If
1548	–	Next j
1549	–	Next i
1715
1716	<	Dim skSeg As SldWorks.SketchSegment
1717	<	Dim x As Double, y As Double, z As Double
1718	<	Dim vretval As Object
1719	<	Dim useEdge As SldWorks.SketchSegment
1720	<	Dim m As Integer
1716	>	swModel.Insert3DSketch2(False)
1717	>	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1718	>	swModel.InsertCompositeCurve()
1719	>	UpdateAttributs(SlyArete1, i)
1720	>	Next i
1721
1722	+	End If
1723
1724	<	For i = 0 To UBound(Pts, 2) - 1
1725	<	swModel.Insert3DSketch2(False)
1726	<	' sélectionner la edge originale
1724	>	' tagger la vieille poutre pour ne pas la reprendre dans magic
1725	>	'Pour ça on ajoute un attribut pour ignorer...
1726	>	Dim nom As String
1727	>	Dim no As Integer
1728	>	Dim arete As sldworks.Edge
1729	>
1730	>	arete = SlyArete1.swArete
1731	>	swEnt = arete
1732	>	nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1733	>	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1734	>	'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1735	>	If attr Is Nothing Then
1736	>	Commun.ColorerAretes()
1737		swEnt = SlyArete1.swArete
1738	<	swEnt.Select4(False, Nothing)
1739	<	swModel.SketchUseEdge2(False)
1564	<	swSketch = swModel.GetActiveSketch2()
1565	<
1566	<	' on créé 2 lignes de construction et on pick de chaque coté... mais on ne le fait pas si on est au premier ou au dernier segment. là on fait juste un pick.
1567	<	If i <> 0 Then ' premier pick, élimine ce qui est avant.
1568	<	skSeg = swModel.CreateLine2(Pts(0, i), Pts(1, i), Pts(2, i), 0.01, 0.01, 0.01)    'pts(0, i - 1) + 10000000 * Epsilon, pts(1, i - 1) + 100000 * Epsilon, pts(2, i - 1) + 100000 * Epsilon)
1569	<	skSeg.ConstructionGeometry = True ' ligne de construction
1570	<	swModel.ClearSelection2(True)
1571	<	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1572	<	SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1573	<	vretval = swSketch.GetSketchSegments
1574	<	useEdge = vretval(0) : m = 0
1575	<	Do Until useEdge.ConstructionGeometry = False
1576	<	m += 1
1577	<	useEdge = vretval(m)
1578	<	Loop
1579	<	useEdge.Select4(False, Nothing)
1580	<	swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1581	<	skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1582	<	skSeg.ConstructionGeometry = True
1583	<	End If
1738	>	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1739	>	End If
1740
1741	<	If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1742	<	skSeg = swModel.CreateLine2(Pts(0, i + 1), Pts(1, i + 1), Pts(2, i + 1), 0.05, 0, 0.01) 'pts(0, i + 1) + 10000000 * Epsilon, pts(1, i + 1) + 1000000 * Epsilon, pts(2, i + 1) + 100000 * Epsilon)
1743	<	skSeg.ConstructionGeometry = True ' ligne de construction
1744	<	swModel.ClearSelection2(True)
1745	<
1746	<	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1747	<	SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1748	<	vretval = swSketch.GetSketchSegments
1749	<	useEdge = vretval(0) : m = 0
1594	<	Do Until useEdge.ConstructionGeometry = False
1595	<	m += 1
1596	<	useEdge = vretval(m)
1597	<	Loop
1598	<
1599	<	useEdge.Select4(False, Nothing)
1600	<	swModel.SketchTrim(1, 0, x, y) ' option = 1 pour trim, selEnd est pas utilisé ?, puis un point x et Y pour sélectionner.  et y'a pas de Z????? c'est un sketch3D!!!!!
1601	<	skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1602	<	skSeg.ConstructionGeometry = True
1603	<	End If
1741	>	Dim p As sldworks.Parameter
1742	>	p = attr.GetParameter("D1")
1743	>	p.SetDoubleValue(-9)
1744	>	p = attr.GetParameter("D2")
1745	>	p.SetDoubleValue(-9)
1746	>	p = attr.GetParameter("D3")
1747	>	p.SetDoubleValue(-9)
1748	>	p = attr.GetParameter("D4")
1749	>	p.SetDoubleValue(-9)
1750
1751	<	swModel.Insert3DSketch2(False)
1606	<	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1607	<	swModel.InsertCompositeCurve()
1608	<	UpdateAttributs(SlyArete1, i)
1609	<	Next i
1751	>	If attr Is Nothing Then MsgBox("Pas marché")
1752
1611	–	End If
1753
1613	–	' tagger la vieille poutre pour ne pas la reprendre dans magic
1614	–	'Pour ça on ajoute un attribut pour ignorer...
1615	–	Dim nom As String
1616	–	Dim no As Integer
1617	–	Dim arete As SldWorks.Edge
1618	–
1619	–	arete = SlyArete1.swArete
1620	–	swEnt = arete
1621	–	nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1622	–	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1623	–	'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1624	–	If attr Is Nothing Then
1625	–	Commun.ColorerAretes()
1626	–	swEnt = SlyArete1.swArete
1627	–	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1754		End If
1755	<
1756	<	Dim p As SldWorks.Parameter
1757	<	p = attr.GetParameter("D1")
1758	<	p.SetDoubleValue(-9)
1633	<	p = attr.GetParameter("D2")
1634	<	p.SetDoubleValue(-9)
1635	<	p = attr.GetParameter("D3")
1636	<	p.SetDoubleValue(-9)
1637	<	p = attr.GetParameter("D4")
1638	<	p.SetDoubleValue(-9)
1639	<
1640	<	If attr Is Nothing Then MsgBox("Pas marché")
1641	<
1642	<
1643	<	End If
1644	<	Next SlyArete1
1645	<
1755	>	Next SlyArete1
1756	>	Catch
1757	>	MsgBox("La seconde boucle n'a pas marchée  Compte: " & count)
1758	>	End Try
1759
1760		End Sub
1761
1762
1763	<	Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByRef i As Integer)
1764	<	Dim newArete As SldWorks.Edge
1765	<	Dim refcurve As SldWorks.ReferenceCurve
1766	<	Dim attr As SldWorks.Attribute
1767	<	Dim swfeat As SldWorks.Feature
1768	<
1763	>	Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByVal i As Integer)
1764	>	Dim newArete As sldworks.Edge
1765	>	Dim refcurve As sldworks.ReferenceCurve
1766	>	Dim attr As sldworks.Attribute = Nothing
1767	>	Dim swfeat As sldworks.Feature
1768	>	swModel.EditRebuild3()
1769		swfeat = swModel.FeatureByPositionReverse(0)
1770
1771	+	Debug.Print(swfeat.Name & "<-- Nom  Typename--> " & swfeat.GetTypeName)
1772	+
1773		refcurve = swfeat.GetSpecificFeature2()
1774		newArete = refcurve.GetFirstSegment()
1775
1776	<	Dim ParamM As SldWorks.Parameter
1777	<	Dim ParamS As SldWorks.Parameter
1778	<	Dim ParamI1 As SldWorks.Parameter
1779	<	Dim ParamI2 As SldWorks.Parameter
1780	<	Dim ParamD1 As SldWorks.Parameter
1781	<	Dim ParamD2 As SldWorks.Parameter
1782	<	Dim ParamD3 As SldWorks.Parameter
1783	<	Dim ParamD4 As SldWorks.Parameter
1784	<	Dim ParamD5 As SldWorks.Parameter
1785	<	Dim ParamD6 As SldWorks.Parameter
1786	<	Dim ParamAs As SldWorks.Parameter
1787	<	Dim ParamN3 As SldWorks.Parameter
1776	>	Dim ParamM As sldworks.Parameter
1777	>	Dim ParamS As sldworks.Parameter
1778	>	Dim ParamI1 As sldworks.Parameter
1779	>	Dim ParamI2 As sldworks.Parameter
1780	>	Dim ParamD1 As sldworks.Parameter
1781	>	Dim ParamD2 As sldworks.Parameter
1782	>	Dim ParamD3 As sldworks.Parameter
1783	>	Dim ParamD4 As sldworks.Parameter
1784	>	Dim ParamD5 As sldworks.Parameter
1785	>	Dim ParamD6 As sldworks.Parameter
1786	>	Dim ParamAs As sldworks.Parameter
1787	>	Dim ParamN3 As sldworks.Parameter
1788
1789	<	attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1789	>	Do While attr Is Nothing
1790	>	attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1791	>	i += 1
1792	>	Loop
1793
1794		ParamM = attr.GetParameter("M")
1795		ParamS = attr.GetParameter("S")
#	Line 1697 | Line 1815 | Module Intersections
1815		ParamD6.SetDoubleValue2(slyarete1.GetD6, 2, "")
1816		ParamAs.SetDoubleValue2(slyarete1.GetAireSection, 2, "")
1817
1818	<	Dim p As SldWorks.Parameter
1818	>	Dim p As sldworks.Parameter
1819		p = attr.GetParameter("N3")
1820		p.SetStringValue(slyarete1.GetN3)
1821		p = attr.GetParameter("X3")
#	Line 1707 | Line 1825 | Module Intersections
1825		p = attr.GetParameter("Z3")
1826		p.SetDoubleValue2(slyarete1.Z3, 2, "")
1827
1828	<	Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1828	>	' Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1829
1830		End Sub
1831
#	Line 1730 | Line 1848 | Module Intersections
1848		For Each coque2 In lst_FaceCoque
1849
1850		If DetectFaceFace(coque2, Face1, True, sketch) Then
1851	<	' création de l'instance de interFace-face entre coque et coque
1851	>	' création de l'instance de interFace-face entre coque et volume
1852	>
1853	>	Dim vSeg As Object = sketch.GetSketchSegments()
1854	>	If vSeg Is Nothing Then
1855	>	DetectFaceFace(coque2, Face1, True, sketch)
1856	>	vSeg = sketch.GetSketchSegments()
1857	>	If vSeg Is Nothing Then MsgBox("Problème") : Err.Raise(555)
1858	>	End If
1859	>
1860
1861
1862		interFF = New InterCoqueVolume
#	Line 1746 | Line 1872 | Module Intersections
1872		coque2.lst_InterCoqueVolume.Add(interFF)
1873		End If
1874
1875	<	Next
1876	<	Next
1875	>	Next coque2
1876	>	Next Face1
1877
1878
1879
#	Line 1824 | Line 1950 | Module Intersections
1950		Dim u() As Double, v() As Double
1951		Dim angle As Double
1952
1953	<	If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume()
1953	>	If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume() : Dim effacer As New SuperArete(interFF.AreteCoque, True) ': effacer.Colorer(2, 0.7, 0, 0.7)
1954		swArete = interFF.AreteCoque
1955		T = Commun.GetTMilieu(swArete)
1956		vmid = swArete.Evaluate(T)
#	Line 1882 | Line 2008 | Module Intersections
2008		''' <remarks></remarks>
2009		Private Sub DécouperCoqueVolume()
2010
2011	+	' Algo:
2012	+	' Pour chaque coque
2013	+	'   Si on doit couper la coque, alors on la coupe
2014	+	' On découpe la face du volume
2015	+	' ON identifie les faces internes
2016	+
2017	+
2018		Dim coque1 As SlyFaceCoque
2019		Dim interFF As InterCoqueVolume
2020
2021		' 1 - Pour toutes les coques
2022	+	Dim lst_face As New Collections.Generic.List(Of SlyFaceVolume)
2023
2024		For Each coque1 In Commun.lst_FaceCoque
2025	+
2026		For Each interFF In coque1.lst_InterCoqueVolume
2027	+
2028	+	'If interFF.Face_A_Plat Then
2029	+	'    If Not lst_face.Contains(interFF.sFaceVolume) Then
2030	+	'        lst_face.Add(interFF.sFaceVolume)
2031	+	'        interFF.DécouperFace_A_Plat()
2032	+	'    End If
2033	+
2034	+
2035		If interFF.FaceDeSection Then
2036		CoupeCoque1(interFF)
2037	+	If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes()
2038		Else
2039	<	interFF.GénérerSweep() ' étape 4
2040	<	interFF.DécouperVolume() ' étape 5
1897	<	If interFF.DoitCouperCoque Then ' on découpe aussi couper la coque selon le sweep
2039	>
2040	>	If interFF.DoitCouperCoque Then
2041		interFF.DecouperCoque()
2042	<	interFF.QuelleAreteCoqueToucheVolume(True)
1900	<	Else
1901	<	interFF.QuelleAreteCoqueToucheVolume(False)
2042	>	interFF.QuelleAreteCoqueToucheVolume()
2043		End If
2044	<	If interFF.DerniereCoupe Then interFF.DecouperCoque()
2045	<	interFF.MarquerFacesInternes() ' étape 6
2044	>	interFF.DécouperVolume()
2045	>	If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes() ' étape 6
2046
2047		End If
2048	<	Next
2048	>	Next interFF
2049		Next coque1
2050
2051
#	Line 1918 | Line 2059 | Module Intersections
2059		''' <param name="int">L'interFaceFace</param>
2060		''' <remarks></remarks>
2061		Private Sub CoupeCoque1(ByRef int As InterCoqueVolume)
1921	–	Dim sCoque As SlyFaceCoque
2062		Dim sVol As SlyFaceVolume
2063		Dim swFace As SldWorks.Face2
2064		Dim swent As SldWorks.Entity
#	Line 1933 | Line 2073 | Module Intersections
2073		swFace = sVol.SwFace
2074		sVol.Selectionner(0, False)
2075
2076	<	' b - lui mettre une esquisse
2077	<	swModel.InsertSketch2(True)
2076	>	'' b - lui mettre une esquisse
2077	>	'swModel.InsertSketch2(True)
2078
2079	<	' c - convertir l'esquisse déjà créée
2080	<	sketch = int.sketch
2081	<	swent = sketch
2082	<	swent.Select2(False, 0)
2083	<
2084	<	swModel.SketchUseEdge2(False)
2085	<
2086	<	' si la face est carrée
2087	<
2088	<	If swFace.GetEdgeCount = 4 Then
2089	<	' d - ajouter des lignes pour  compléter l'esquisse
2090	<	Dim longueur(3) As Double
2091	<
2092	<
2093	<	Dim vLine As Object
2094	<	Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2095	<	Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2096	<	Dim skSeg As SldWorks.SketchSegment
2097	<	vEdges = swFace.GetEdges()
2098	<	For Each swArete In vEdges
2099	<	ReDim Preserve aretes(i)
2100	<	aretes(i) = swArete
2101	<	i += 1
2102	<	Next
2103	<	For i = 0 To 3
2104	<	longueur(i) = Commun.GetLongueurArete(vEdges(i))
2105	<	Next i
2106	<	longueur = Ordonner(longueur, aretes)
2079	>	'' c - convertir l'esquisse déjà créée
2080	>	'sketch = int.sketch
2081	>	'swent = sketch
2082	>	'swent.Select2(False, 0)
2083	>
2084	>	'swModel.SketchUseEdge2(False)
2085	>
2086	>	'' si la face est carrée
2087	>
2088	>	'If swFace.GetEdgeCount = 4 Then
2089	>	'    ' d - ajouter des lignes pour  compléter l'esquisse
2090	>	'    Dim longueur(3) As Double
2091	>
2092	>
2093	>	'    Dim vLine As Object
2094	>	'    Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2095	>	'    Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2096	>	'    Dim skSeg As SldWorks.SketchSegment
2097	>	'    vEdges = swFace.GetEdges()
2098	>	'    For Each swArete In vEdges
2099	>	'        ReDim Preserve aretes(i)
2100	>	'        aretes(i) = swArete
2101	>	'        i += 1
2102	>	'    Next
2103	>	'    For i = 0 To 3
2104	>	'        longueur(i) = Commun.GetLongueurArete(vEdges(i))
2105	>	'    Next i
2106	>	'    longueur = Ordonner(longueur, aretes)
2107	>
2108	>	'    swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
2109	>	'    swModel.SketchUseEdge2(False)
2110	>	'    sketch = swModel.GetActiveSketch()
2111	>	'    vLine = sketch.GetSketchSegments()
2112	>	'    skSeg = vLine(0) : line1 = skSeg
2113	>	'    skSeg = vLine(1) : line2 = skSeg
2114	>
2115	>	'    P1 = line1.GetStartPoint2()
2116	>	'    P2 = line1.GetEndPoint2()
2117	>	'    P3 = line2.GetStartPoint2()
2118	>	'    P4 = line2.GetEndPoint2()
2119	>
2120	>	'    If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
2121	>	'        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2122	>	'        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2123	>	'    Else ' ligne entre 1 et 4 & 2 et 3
2124	>	'        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2125	>	'        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2126	>	'    End If
2127	>	'Else
2128	>	'    sketch = swModel.GetActiveSketch()
2129	>	'End If
2130	>	'swModel.InsertSketch2(True)
2131
1968	–	swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
1969	–	swModel.SketchUseEdge2(False)
1970	–	sketch = swModel.GetActiveSketch()
1971	–	vLine = sketch.GetSketchSegments()
1972	–	skSeg = vLine(0) : line1 = skSeg
1973	–	skSeg = vLine(1) : line2 = skSeg
1974	–
1975	–	P1 = line1.GetStartPoint2()
1976	–	P2 = line1.GetEndPoint2()
1977	–	P3 = line2.GetStartPoint2()
1978	–	P4 = line2.GetEndPoint2()
1979	–
1980	–	If Distance(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z) < Distance(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z) Then ' ligne entre 1 et 3
1981	–	swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
1982	–	swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
1983	–	Else ' ligne entre 1 et 4 & 2 et 3
1984	–	swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
1985	–	swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
1986	–	End If
1987	–	Else
1988	–	sketch = swModel.GetActiveSketch()
1989	–	End If
1990	–	swModel.InsertSketch2(True)
2132
2133	+	'' e - splitter
2134	+	'swent = swFace : swent.Select2(False, 1)
2135	+	'swent = sketch : swent.Select2(True, 4)
2136	+	'swModel.InsertSplitLineProject(False, False)
2137
1993	–	' e - splitter
1994	–	swent = swFace : swent.Select2(False, 1)
1995	–	swent = sketch : swent.Select2(True, 4)
1996	–	swModel.InsertSplitLineProject(False, False)
2138
2139	+	sVol.Selectionner(32, False) 'swPart.Extension.SelectByID2("", "FACE", 0.05746341258515, 0.007456177698316, 0.04437034503314, False, 16, Nothing, 0)
2140	+	int.sFaceCoque.Selectionner(16, True) 'swPart.Extension.SelectByID2("", "FACE", 0.03921396269902, -0.007016448377556, 0, True, 32, Nothing, 0)
2141	+	swPart.FeatureManager.InsertSplitLineIntersect(7)
2142
2143		' f - mettre un FaceInterne sur les 2 faces résultantes.
2144		Dim swFeat As SldWorks.Feature
#	Line 2009 | Line 2153 | Module Intersections
2153		swFace1 = vFace(0)
2154		swFace2 = vFace(1)
2155
2156	<	swent = swFace1
2157	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2158	<	nom = "FaceInterneCoque1"
2159	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2160	<
2161	<	While attr Is Nothing
2162	<	no += 1
2163	<	nom = "FaceInterneCoque" & CStr(no)
2164	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2165	<	End While
2166	<	GererDossiers("FaceInternes", nom)
2167	<
2168	<	swent = swFace2
2169	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2170	<	nom = "FaceInterneCoque1"
2171	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2172	<
2173	<	While attr Is Nothing
2174	<	no += 1
2175	<	nom = "FaceInterneCoque" & CStr(no)
2176	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2177	<	End While
2178	<	GererDossiers("FaceInternes", nom)
2156	>	sVol.AjouterFace(swFace1)
2157	>	sVol.AjouterFace(swFace2)
2158	>
2159	>	'Dim eFace As New SlyFaceVolume(swFace1, True)
2160	>	'eFace.MettreAttributFaceInterne(swFace1, , False)
2161	>
2162	>	'swent = swFace1
2163	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2164	>	'nom = "FaceInterneCoque1"
2165	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2166	>
2167	>	'While attr Is Nothing
2168	>	'    no += 1
2169	>	'    nom = "FaceInterneCoque" & CStr(no)
2170	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2171	>	'End While
2172	>	'GererDossiers("FaceInternes", nom)
2173	>
2174	>	'swent = swFace2
2175	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2176	>	'nom = "FaceInterneCoque1"
2177	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2178	>
2179	>	'While attr Is Nothing
2180	>	'    no += 1
2181	>	'    nom = "FaceInterneCoque" & CStr(no)
2182	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2183	>	'End While
2184	>	'GererDossiers("FaceInternes", nom)
2185
2186
2187		End Sub
#	Line 2061 | Line 2211 | Module Intersections
2211		''' <param name="face1">Première face</param>
2212		''' <param name="face2">Seconde face</param>
2213		''' <param name="dessiner">Si l'on veut dessiner une esquisse contenant la courbe</param>
2214	<	''' <param name="Sketch">Si la première option est vrai, ce paramètre redonne l'esquisse qui contient la courbe</param>
2214	>	''' <param name="Sketch">Si la précédente option est vrai, ce paramètre redonne l'esquisse qui contient la courbe (peut contenir plusieurs segments) d'intersection</param>
2215		''' <returns>Vrai si les faces se touchent</returns>
2216		''' <remarks>Si les 2 faces se touchent en un seul point alors ça retourne faux.</remarks>
2217		Private Function DetectFaceFace(ByRef face1 As SldWorks.Face2, ByRef face2 As SldWorks.Face2, Optional ByRef dessiner As Boolean = False, Optional ByRef Sketch As SldWorks.Sketch = Nothing) As Boolean
2218	<	' sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2219	<	Dim Surface1 As SldWorks.Surface
2220	<	Dim Surface2 As SldWorks.Surface
2218	>	'sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2219	>	Dim Surface1 As sldworks.Surface
2220	>	Dim Surface2 As sldworks.Surface
2221		Dim curveArray As Object = Nothing
2222	<	Dim curve As SldWorks.Curve
2222	>	Dim curve As sldworks.Curve
2223		Dim ret As Boolean
2224		Dim boundsArray As Object = Nothing
2225		Dim bounds() As Double
#	Line 2090 | Line 2240 | Module Intersections
2240		If Not ret Then Return False
2241		bounds = boundsArray
2242
2093	–	'On Error GoTo faceSurFace
2243		Try
2244		curve = curveArray(0)
2245		Catch
2246	<	Debug.Write("On a une intersection où 2 faces sont sur la même surface...")
2247	<	Return False ' ouch... pas certain.
2246	>
2247	>	'MsgBox("On a une intersection où 2 faces sont sur la même surface...") ' en théorie...
2248	>	Return True ' ouch... pas certain.
2249		End Try
2250
2251
#	Line 2106 | Line 2256 | Module Intersections
2256		Dim vParam As Object
2257		vParam = curve.GetClosestPointOn(P1(0), P1(1), P1(2))  ' vparam(3) est le U
2258
2259	<	P1 = curve.Evaluate(vParam(3) + 100 * Epsilon) : Point1 = P1
2260	<	P2 = curve.Evaluate(vParam(3) - 100 * Epsilon) : Point2 = P2
2259	>	P1 = curve.Evaluate(vParam(3) + 100000 * Epsilon) : Point1(0) = P1(0) : Point1(1) = P1(1) : Point1(2) = P1(2)
2260	>	P2 = curve.Evaluate(vParam(3) - 100000 * Epsilon) : Point2(0) = P2(0) : Point2(1) = P2(1) : Point2(2) = P2(2)
2261
2262	<	If (Distance(face1, Point1(0), Point1(1), Point1(2)) < Epsilon) And (Distance(face2, Point1(0), Point1(1), Point1(2)) < Epsilon) Then
2263	<	ElseIf (Distance(face1, Point2(0), Point2(1), Point2(2)) < Epsilon) And (Distance(face2, Point2(0), Point2(1), Point2(2)) < Epsilon) Then
2262	>	' si p1 et p2 sont identiques alors on a un point D'intersection, ce que l'on ne veut pas
2263	>	If Distance(Point1, Point2) < 1000 * Epsilon Then Return False
2264	>
2265	>	If ((Distance(face1, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon)) AndAlso (Distance(face2, Point1(0), Point1(1), Point1(2)) < (1000 * Epsilon))) OrElse ((Distance(face1, Point2(0), Point2(1), Point2(2)) < (Epsilon * 1000)) AndAlso (Distance(face2, Point2(0), Point2(1), Point2(2)) < (1000 * Epsilon))) Then
2266	>	' return true
2267		Else
2268	<	Return False
2268	>	Dim swent2 As sldworks.Entity
2269	>	Dim feat2 As sldworks.Feature
2270	>	swModel.Insert3DSketch2(False)
2271	>	swModel.ClearSelection2(True)
2272	>	swent2 = face1 : swent2.Select2(False, 0)
2273	>	swent2 = face2 : swent2.Select2(True, 0)
2274	>	swModel.Sketch3DIntersections()
2275	>
2276	>	swModel.Insert3DSketch2(False)
2277	>	swModel.EditRebuild3()
2278	>	feat2 = swModel.FeatureByPositionReverse(0)
2279	>
2280	>	Sketch = feat2.GetSpecificFeature2
2281	>	feat2.Name = "TouchePas" & CStr(Rnd())
2282	>	Dim vSeg2 As Object = Sketch.GetSketchSegments()
2283	>	If vSeg2 Is Nothing Then
2284	>	swent2 = feat2
2285	>	swent2.Select(False)
2286	>	swModel.EditDelete()
2287	>	Return False
2288	>	Else
2289	>	Return True
2290	>	End If
2291		End If
2292		End If
2293
2294	+	Dim swent As sldworks.Entity
2295	+	Dim feat As sldworks.Feature
2296	+	swModel.Insert3DSketch2(False)
2297	+	swModel.ClearSelection2(True)
2298	+	swent = face1 : swent.Select2(False, 0)
2299	+	swent = face2 : swent.Select2(True, 0)
2300	+	swModel.Sketch3DIntersections()
2301
2302	+	swModel.Insert3DSketch2(False)
2303	+	swModel.EditRebuild3()
2304	+	feat = swModel.FeatureByPositionReverse(0)
2305
2306	<	If dessiner Then
2307	<	Dim swent As SldWorks.Entity
2308	<	Dim feat As SldWorks.Feature
2309	<	swModel.Insert3DSketch2(False)
2310	<
2311	<	swent = face1 : swent.Select2(False, 0)
2312	<	swent = face2 : swent.Select2(True, 0)
2313	<	swModel.Sketch3DIntersections()
2314	<
2130	<	swModel.Insert3DSketch2(False)
2131	<	swModel.EditRebuild3()
2132	<	feat = swModel.FeatureByPositionReverse(0)
2133	<
2134	<	Sketch = feat.GetSpecificFeature2
2306	>	Sketch = feat.GetSpecificFeature2
2307	>	Dim vSeg As Object = Sketch.GetSketchSegments()
2308	>	If vSeg Is Nothing Then
2309	>	swent = feat
2310	>	swent.Select(False)
2311	>	swModel.EditDelete()
2312	>	Return False
2313	>	Else
2314	>	Return True
2315		End If
2316
2317		Return True
2138	–	'If curve.IsTrimmedCurve = False And curve.IsLine Then    ' si c'est une ligne, alors l'enfoirée est de longueur infinie. courbe spline... pas de problèmes.
2139	–
2140	–	'    Dim vEdge As Object, swAreteTest As SldWorks.Edge, xyz() As Double = Nothing, n As Integer
2141	–	'    Dim lst_T() As Double = Nothing, final() As Double
2142	–	'    Dim NewCourbe As SldWorks.Curve
2143	–
2144	–	'    For n = 1 To 2
2145	–	'        If n = 1 Then vEdge = face1.GetEdges() Else vEdge = face2.GetEdges()
2146	–	'        For f = 0 To UBound(vEdge)
2147	–	'            swAreteTest = vEdge(f)
2148	–	'            If DetectAreteArete(swAreteTest, curve, xyz) Then
2149	–
2150	–	'                If Not UBound(xyz) > 4 Then
2151	–	'                    vT = curve.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
2152	–	'                    T = vT(3)
2153	–
2154	–	'                    If lst_T Is Nothing Then ReDim lst_T(0) Else ReDim Preserve lst_T(UBound(lst_T) + 1)
2155	–	'                    lst_T(UBound(lst_T)) = T
2156	–	'                End If
2157	–	'            End If
2158	–	'        Next f
2159	–	'    Next n
2160	–
2161	–	'    final = trier(lst_T)
2162	–
2163	–	'    For i = 0 To UBound(final) Step 2
2164	–	'        Dim skseg As SldWorks.SketchSegment, angle As Double
2165	–
2166	–	'        Point1 = curve.Evaluate(final(i)) : Point2 = curve.Evaluate(final(i + 1))
2167	–	'        NewCourbe = curve.CreateTrimmedCurve2(Point1(0), Point1(1), Point1(2), Point2(0), Point2(1), Point2(2))
2168	–	'        If dessiner Then skseg = Commun.DessineCourbe(NewCourbe) : Sketch = skseg.GetSketch
2169	–	'        angle = AngleEntre2Faces(face1, face2, Point1) / 0.0174532925
2170	–
2171	–	'        'swApp.SendMsgToUser(" Courbe Droite " & angle)
2172	–	'    Next
2173	–
2174	–	'ElseIf curve.IsTrimmedCurve = False Then  ' courbe périodique... donc pas trimmée mais avec des bounds...
2175	–	'    If dessiner Then
2176	–	'        Commun.DessineCourbe(curve)
2177	–	'        Sketch = swModel.FeatureByPositionReverse(0)
2178	–	'    End If
2179	–
2180	–
2181	–	'Else
2182	–	'    If dessiner Then
2183	–	'        Commun.DessineCourbe(curve)
2184	–	'        Sketch = swModel.FeatureByPositionReverse(0)
2185	–	'    End If
2186	–	'End If
2318
2188	–	'Return True
2189	–	faceSurFace:  ' les 2 surfaces sont une sur l'autre...
2190	–	'Dim swent As SldWorks.Entity
2191	–	'Dim swent2 As SldWorks.Entity
2192	–	'swent = face1 : swent.Select2(False, 0)
2193	–	'swent2 = face2 : swent2.Select2(True, 0)
2194	–	'MsgBox("2 Faces avec une surface commune...")
2195	–	'Return True
2319		End Function
2320
2321
#	Line 2265 | Line 2388 | faceSurFace:  ' les 2 surfaces sont une
2388		End Function
2389
2390
2391	+	''' <summary>
2392	+	''' Sub qui fait comme le tavail de Antoine et Rémi et qui créé un fichier pour la carte de taille.  Si l'option de pré-optimisation est enclenchée, la sub ne fait qu'ajouter des éléments au fichier .txt
2393	+	''' </summary>
2394	+	''' <remarks></remarks>
2395	+	Public Sub FairePreCarte()
2396	+
2397	+	Dim ligne_txt As String
2398	+	Dim fichier As System.IO.StreamWriter
2399	+	Dim EcartNodal As Double = Commun.ÉcartNodal
2400	+
2401	+	' si le fichier pog n'est pas encore créé, on doit le faire...
2402	+	If Commun.NomFichierPog = Nothing Then
2403	+	' la première ligne donne la boite englobante, la seconde la taille ENG
2404	+
2405	+	Dim path As String = Nothing
2406	+	Dim CMDialogl As New Windows.Forms.SaveFileDialog
2407	+	CMDialogl.DefaultExt = ".txt"
2408	+	CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
2409	+
2410	+	CMDialogl.OverwritePrompt = True
2411	+	CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
2412	+	CMDialogl.ShowDialog()
2413	+	path = CMDialogl.FileName
2414	+	path = Txtpath(path) : Commun.NomFichierPog = path
2415	+	If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!")
2416	+
2417	+	fichier = System.IO.File.CreateText(path)
2418	+
2419	+	Dim vBox As Object = swPart.GetPartBox(True)
2420	+	Dim box() As Double = vBox
2421	+
2422	+	Dim centre(2) As Double ' le centre de la boite englobante
2423	+	Dim longueurs(2) As Double
2424	+
2425	+	centre(0) = (box(3) + box(0)) / 2
2426	+	centre(1) = (box(4) + box(1)) / 2
2427	+	centre(2) = (box(5) + box(2)) / 2
2428	+
2429	+	longueurs(0) = (box(3) - box(0)) * 1.25
2430	+	longueurs(1) = (box(4) - box(1)) * 1.25
2431	+	longueurs(2) = (box(5) - box(2)) * 1.25
2432	+
2433	+
2434	+	ligne_txt = CStr(centre(0) - longueurs(0) / 2) & " " & CStr(centre(1) - longueurs(1) / 2) & " " & CStr(centre(2) - longueurs(2) / 2) & " " & CStr(centre(0) + longueurs(0) / 2) & " " & CStr(centre(1) + longueurs(1) / 2) & " " & CStr(centre(2) + longueurs(2) / 2)
2435	+	fichier.WriteLine(Replace(ligne_txt, ",", "."))
2436	+
2437	+	fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2438	+	Else
2439	+	' Le fichier pog existe déjà...
2440	+	fichier = System.IO.File.AppendText(Commun.NomFichierPog)
2441	+	'fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2442	+	End If
2443	+
2444	+
2445	+	' *** C'est ici que le fun se passe.
2446	+
2447	+
2448	+	' 1 - On parcourt toutes les faces, les listes sont déjà RE-crées, donc pas de multifaces
2449	+	For Each sFace As SlyFaceVolume In Commun.lst_FaceVolume
2450	+	sFace.MettrePointSurPOG(fichier)
2451	+	Next
2452	+
2453	+
2454	+
2455	+	' *** Fin
2456	+	fichier.Close()
2457	+	End Sub
2458	+
2459	+	''' <summary>
2460	+	''' Fonction qui compare 2 surfaces
2461	+	''' </summary>
2462	+	''' <param name="swSurf1">La première surface</param>
2463	+	''' <param name="swSurf2">La seconde</param>
2464	+	''' <returns>Vrai si les 2 surfaces sont identiques, faux sinon</returns>
2465	+	''' <remarks></remarks>
2466	+	Public Function ComparerSurfaces(ByRef swSurf1 As sldworks.Surface, ByRef swSurf2 As sldworks.Surface) As Boolean
2467	+	'swSurf1.GetBSurfParams2(True,False,
2468	+
2469	+
2470	+	If swSurf1.IsPlane And swSurf2.IsPlane Then
2471	+	Dim obj1 As Object = swSurf1.PlaneParams
2472	+	Dim obj2 As Object = swSurf2.PlaneParams
2473	+	For i As Integer = 0 To 2
2474	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2475	+	Next
2476	+	Return True
2477	+	ElseIf swSurf1.IsBlending And swSurf2.IsBlending Then
2478	+	' pas de blendingParams
2479	+
2480	+	ElseIf swSurf1.IsCone And swSurf2.IsCone Then
2481	+	Dim obj1 As Object = swSurf1.ConeParams
2482	+	Dim obj2 As Object = swSurf2.ConeParams
2483	+	For i As Integer = 0 To 7
2484	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2485	+	Next
2486	+	Return True
2487	+
2488	+	ElseIf swSurf1.IsCylinder And swSurf2.IsCylinder Then
2489	+	Dim obj1 As Object = swSurf1.CylinderParams
2490	+	Dim obj2 As Object = swSurf2.CylinderParams
2491	+	For i As Integer = 0 To 6
2492	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2493	+	Next
2494	+	Return True
2495	+	ElseIf swSurf1.IsForeign And swSurf2.IsForeign Then
2496	+	' ???
2497	+	ElseIf swSurf1.IsOffset And swSurf2.IsOffset Then
2498	+	' Pas de offsetParam
2499	+
2500	+	ElseIf swSurf1.IsParametric And swSurf2.IsParametric Then
2501	+	' pas de ParametricParams
2502	+
2503	+	ElseIf swSurf1.IsRevolved And swSurf2.IsRevolved Then
2504	+	' pas de revolvedparams
2505	+
2506	+	ElseIf swSurf1.IsSphere And swSurf2.IsSphere Then
2507	+	Dim obj1 As Object = swSurf1.SphereParams
2508	+	Dim obj2 As Object = swSurf2.SphereParams
2509	+
2510	+	For i As Integer = 0 To 3
2511	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2512	+	Next
2513	+	Return True
2514	+	ElseIf swSurf1.IsSwept And swSurf2.IsSwept Then
2515	+	' merde, il n'y a pas de Sweptparams
2516	+
2517	+	ElseIf swSurf1.IsTorus And swSurf2.IsTorus Then
2518	+	Dim obj1 As Object = swSurf1.TorusParams
2519	+	Dim obj2 As Object = swSurf2.TorusParams
2520	+
2521	+	For i As Integer = 0 To 7
2522	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2523	+	Next
2524	+	Return True
2525	+	Else
2526	+	' faut quand même évaluer si on a la bonne chose...
2527	+	Dim obj As Object = swSurf1.GetClosestPointOn(0, 0, 0) ' x, y , z, U, V
2528	+
2529	+	Dim obj1 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2530	+	Dim obj2 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2531	+
2532	+	If Math.Abs(obj1(9) - obj2(9)) < Epsilon And Math.Abs(obj1(10) - obj2(10)) < Epsilon Then
2533	+	' c'est cheap.... mais
2534	+	Return True
2535	+	End If
2536	+	Return False
2537	+
2538	+	End If
2539	+
2540	+	Return False
2541	+
2542	+
2543	+
2544	+	End Function
2545
2546
2547		End Module

Diff Legend

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