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 46 by bournival, Wed Aug 22 18:28:53 2007 UTC vs.
Revision 205 by bournival, Thu Jul 23 20:53:57 2009 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 5 | Line 9 | Module Intersections
9		Public DefAttrRCCoque As SldWorks.AttributeDef
10		Public DefAttrFaceInterne As SldWorks.AttributeDef
11		Public DefAttrDoublon As SldWorks.AttributeDef
12	<	Public DefAttrIgnorer As SldWorks.AttributeDef
12	>	Public DefAttrIgnorer As sldworks.AttributeDef
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	+	Public SectionSimpleSurPoutre As Boolean
21
22		#Region "Enums"
23		Public Enum typeInterPoutreVolume
#	Line 27 | Line 35 | Module Intersections
35		' *******
36		' quelques options de performance
37		' *******
38	<	swApp.SetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
38	>	swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 0)
39		swModel.SetAddToDB(True)
40		swModel.SetDisplayWhenAdded(False)
41	+	swModel.SetInferenceMode(False)
42		' ******
43		' fin des options de performance
44		' ******
45
46	+
47	+
48		Memoriser3iemePoint() ' mémorise le coord system car si on découpe, sa coordonnée est perdue.
49	+
50		CouperPoutres()
51		Commun.GenererListes() ' va ignorer les poutres à ignorer... et ajouter les poutres coupées dans la liste.
52
53	+	lst_InterCoqueCoque.Clear()
54	+	DetectionCoqueCoque()
55	+	DetectionPoutresVolumes() ' doit être avant interpoutreCoque au cas où on aurait une poutre de section
56	+	DetectionPoutresCoques()
57	+	DetectionCoqueVolume()
58
59
43	–	' Traitement des intersection poutres-Volumes
44	–	DetectionPoutresVolumes()
45	–	DecouperPoutreVolume()
46	–	' fin traitement intersection poutres-volumes
60
48	–	swModel.EditRebuild3()
61
62
63
64	+	' Traitement des intersection poutres-Volumes
65	+	DecouperPoutreVolume()
66	+	swModel.EditRebuild3()
67	+
68		' Traitement des intersection entre poutre et coques
53	–	DetectionPoutresCoques()
69		DecouperPoutreCoque()
70	<	' Fin du traitement des intersections entre poutre et coques
56	<
70	>	swModel.EditRebuild3()
71
72		' traitement des coques-volumes
59	–	DetectionCoqueVolume()
73		DécouperCoqueVolume()
74	<	' fin traitement coque volume
74	>	swModel.EditRebuild3()
75
76		' traitement des coques-coques
64	–	DetectionCoqueCoque()
77		DecouperCoqueCoque()
78	<	'
78	>	swModel.EditRebuild3()
79	>
80
81
82
83		' *******
84		' quelques options de performance, remettre à la position initiale
85		' *******
86	<	swApp.SetUserPreferenceIntegerValue(SwConst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
86	>	swApp.SetUserPreferenceIntegerValue(swconst.swUserPreferenceIntegerValue_e.swAutoSaveInterval, 15)
87		swModel.SetAddToDB(False)
88		swModel.SetDisplayWhenAdded(True)
89		swModel.GraphicsRedraw2()
90	+	swModel.SetInferenceMode(True)
91		' ******
92		' fin des options de performance
93		' ******
#	Line 90 | Line 104 | Module Intersections
104		Private Sub DecouperCoqueCoque()
105		Dim rayon As Double
106
107	+	For Each interCC As InterCoqueCoque In lst_InterCoqueCoque
108	+	'rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
109	+	'MsgBox("Traitement de l'intersection de coque - coque # " & interCC.Numero)
110	+
111	+	Try
112	+	If interCC.DoitCouperCoque1 Then
113	+	rayon = interCC.sFaceCoque2.GetEpaisseur / 2
114	+	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
115	+	interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
116	+	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
117	+	End If
118
119	<	For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
120	<	For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
121	<	rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
122	<	Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
123	<	interCC.DecouperCoque(Coque, sweep)
119	>	If interCC.DoitCouperCoque2 Then
120	>	rayon = interCC.sFaceCoque1.GetEpaisseur / 2
121	>	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
122	>	interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
123	>	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
124	>	End If
125	>	Catch
126	>	If interCC.DoitCouperCoque2 Then
127	>	rayon = interCC.sFaceCoque1.GetEpaisseur / 2
128	>	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
129	>	interCC.DecouperCoque(interCC.sFaceCoque2, sweep)
130	>	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque1, interCC.sFaceCoque2)
131	>	End If
132
133	<	' reste à retrouver les faces internes.
134	<	interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
135	<	Next
133	>	If interCC.DoitCouperCoque1 Then
134	>	rayon = interCC.sFaceCoque2.GetEpaisseur / 2
135	>	Dim sweep As sldworks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
136	>	interCC.DecouperCoque(interCC.sFaceCoque1, sweep)
137	>	If Intersections.MettreMiniPoutresSurFaceInternes Then interCC.MarquerFacesInternes(interCC.sFaceCoque2, interCC.sFaceCoque1)
138	>	End If
139	>
140	>
141	>	End Try
142	>
143	>
144	>
145	>
146	>
147	>	If interCC.FaceAPlat Then
148	>	interCC.CoupeAPlat()
149	>	End If
150	>
151	>	' reste à retrouver les faces internes.
152	>	'interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
153		Next
154
155
156		End Sub
157
158	+	'Private Sub DecouperCoqueCoque()
159	+	'    Dim rayon As Double
160	+
161	+
162	+	'    For Each Coque As SlyFaceCoque In Commun.lst_FaceCoque
163	+	'        For Each interCC As InterCoqueCoque In Coque.lst_InterCoqueCoque
164	+	'            rayon = IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2.GetEpaisseur, interCC.sFaceCoque1.GetEpaisseur)
165	+	'            Dim sweep As SldWorks.Body2 = interCC.GénérerSweep(interCC.sketch, rayon)
166	+	'            interCC.DecouperCoque(Coque, sweep)
167	+
168	+	'            ' reste à retrouver les faces internes.
169	+	'            interCC.MarquerFacesInternes(IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque2, interCC.sFaceCoque1), IIf(Coque Is interCC.sFaceCoque1, interCC.sFaceCoque1, interCC.sFaceCoque2))
170	+	'        Next
171	+	'    Next
172	+
173	+
174	+	'End Sub
175	+
176	+
177	+
178		''' <summary>
179		'''  sub qui créé une instance de la classe interCoqueCoque s'il y a une intersection de ce type
180		''' </summary>
#	Line 122 | Line 192 | Module Intersections
192		If DetectFaceFace(Coque2.SwFace, Coque1.SwFace, True, sketch) Then
193		' création de l'instance de interFace-face entre coque et coque
194
195	<	interCC = New InterCoqueCoque
126	<	interCC.sFaceCoque1 = Coque1
127	<	interCC.sFaceCoque2 = Coque2
195	>	interCC = New InterCoqueCoque(Coque1, Coque2)
196		interCC.FaceDeSection = False
197		interCC.sketch = sketch
198	+	interCC.determineType()
199	+	lst_InterCoqueCoque.Add(interCC)
200	+
201
202	<	Coque1.lst_InterCoqueCoque.Add(interCC)
203	<	Coque2.lst_InterCoqueCoque.Add(interCC)
202	>	'Coque1.lst_InterCoqueCoque.Add(interCC)
203	>	'Coque2.lst_InterCoqueCoque.Add(interCC)
204		End If
205
206		Next j
#	Line 183 | Line 254 | Module Intersections
254
255		nom = "InterALAL"
256		DefAttrInterALAL = swApp.DefineAttribute(nom)
257	<	DefAttrInterALAL.AddParameter("X", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
258	<	DefAttrInterALAL.AddParameter("Y", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
259	<	DefAttrInterALAL.AddParameter("Z", SwConst.swParamType_e.swParamTypeDouble, 0, 0)
260	<	DefAttrInterALAL.AddParameter("T", SwConst.swParamType_e.swParamTypeDouble, -1, 0)
257	>	DefAttrInterALAL.AddParameter("X", swconst.swParamType_e.swParamTypeDouble, 0, 0)
258	>	DefAttrInterALAL.AddParameter("Y", swconst.swParamType_e.swParamTypeDouble, 0, 0)
259	>	DefAttrInterALAL.AddParameter("Z", swconst.swParamType_e.swParamTypeDouble, 0, 0)
260	>	DefAttrInterALAL.AddParameter("T", swconst.swParamType_e.swParamTypeDouble, -1, 0)
261		retval = DefAttrInterALAL.Register()
262		If retval = False Then MsgBox("Enregistrement raté pour le InterALAL")
263
264
265		nom = "ConditionLimite"
266		DefAttrConditionLimite = swApp.DefineAttribute(nom)
267	<	DefAttrConditionLimite.AddParameter("CL", SwConst.swParamType_e.swParamTypeString, 0, 0)
267	>	DefAttrConditionLimite.AddParameter("CL", swconst.swParamType_e.swParamTypeString, 0, 0)
268		retval = DefAttrConditionLimite.Register()
269		If retval = False Then MsgBox("Enregistrement raté pour le COndition Limite")
270
#	Line 215 | Line 286 | Module Intersections
286		DefAttrRCP1.AddParameter("D5", 0, 0, 0)
287		DefAttrRCP1.AddParameter("D6", 0, 0, 0)
288		DefAttrRCP1.AddParameter("Flag", 0, 0, 0)
218	–
289		retval = DefAttrRCP1.Register()
290		If retval = False Then MsgBox("Enregistrement raté pour le RCPoutre")
291
#	Line 227 | Line 297 | Module Intersections
297		If retval = False Then MsgBox("Enregistrement raté pour le RCCoque")
298
299		DefAttrFaceInterne = swApp.DefineAttribute("FaceInterne")
300	<	DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la présence de l'attribut est suffisante.
300	>	DefAttrFaceInterne.AddParameter("FI", 0, 0, 0)  ' la taille des éléments
301	>	DefAttrFaceInterne.AddParameter("Po", 0, 0, 0)  ' =0 si poutre, =1 si coque
302		retval = DefAttrFaceInterne.Register()
303		If retval = False Then MsgBox("Enregistrement raté pour le FaceInterne")
304
#	Line 243 | Line 314 | Module Intersections
314		retval = DefAttrIgnorer.Register()
315		If retval = False Then MsgBox("Enregistrement raté pour le Ignorer")
316
317	+
318		nouveau = True
319
320		End Sub
#	Line 535 | Line 607 | Module Intersections
607
608		If sPoutre.Evaluer(T1, PointTest) Then
609		' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
610	<	If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
610	>	If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
611		' on est dans la coque.
612		If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
613		End If
614		End If
615
616		If sPoutre.Evaluer(T2, PointTest) Then
617	<	effacer = Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2))
618	<	If Distance(sCoque.lst_Faces.Item(1), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
617	>	effacer = Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2))
618	>	If Distance(sCoque.lst_Faces.Item(0), PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
619		If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
620		End If
621		End If
#	Line 627 | Line 699 | Module Intersections
699		''' <remarks></remarks>
700		Private Sub DecouperPoutreVolume()
701		' #2 on procède au découpage de la face
702	<	Dim sVol As SlyFaceVolume
702	>	Dim sFaceVol As SlyFaceVolume
703
704	<	For Each sVol In lst_FaceVolume
705	<	If sVol.lst_InterPoutre.Count > 0 Then
706	<	sVol.decouper()
704	>	For Each sFaceVol In lst_FaceVolume
705	>	If sFaceVol.lst_InterPoutre.Count > 0 Then
706	>	sFaceVol.decouper()
707
708		' on met-a-jour l'attribut des conditions aux limites
709	<	Dim attr As SldWorks.Attribute
710	<	Dim swent As SldWorks.Entity
709	>	Dim attr As sldworks.Attribute
710	>	Dim swent As sldworks.Entity
711		Dim nom3 As String = Nothing
712	<	Dim p As SldWorks.Parameter
713	<	If Not sVol.AttributCL Is Nothing Then
714	<	nom3 = "CL_" & sVol.nom
715	<	swent = sVol.SwFace
712	>	Dim p As sldworks.Parameter
713	>	If Not sFaceVol.AttributCL Is Nothing Then
714	>	nom3 = "CL_" & sFaceVol.nom
715	>	swent = sFaceVol.SwFace
716		attr = swent.FindAttribute(Intersections.DefAttrConditionLimite, 0) ' si l'attribut existe déjà on pointe dessus.
717
718	<	If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sVol.SwFace, nom3, 0, 0)
718	>	If attr Is Nothing Then attr = Intersections.DefAttrConditionLimite.CreateInstance5(swModel, sFaceVol.SwFace, nom3, 0, 0)
719		p = attr.GetParameter("CL")
720	<	p.SetStringValue(sVol.condition)
720	>	p.SetStringValue(sFaceVol.condition)
721
722		End If
723		GererDossiers("Conditions Aux Limites", nom3)
#	Line 678 | Line 750 | Module Intersections
750		' 1 - Spotter la ou les faces en question
751		xyz = sPoutre.GetStartPoint
752		xyz2 = sPoutre.GetEndPoint
753	+
754		For Each sVol In Commun.lst_FaceVolume
755		If Intersections.DetectSurfaceArete(sPoutre.swArete, sVol.SwFace, Nothing) Then
756		swModel.ClearSelection2(True)
757		sVol.Selectionner()
758		section = swExt.GetSectionProperties2(sVol.SwFace) : proprietes = section
759		swModel.ClearSelection2(True)
760	<	' la fontion getsectionproperties renvoie des valeurs dont la précision est très douteuse...
760	>	' la fonction getsectionproperties renvoie des valeurs dont la précision est très douteuse...
761		' on met alors une beaucoup plus grosse tolérance...
762	<	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
763	<	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
762	>	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
763	>	Face1 = sVol : prop1 = proprietes
764	>	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
765	>	Face2 = sVol : prop2 = proprietes
766	>	Else
767	>	' on a une intersection où la poutre touche à une face «guide» et une autre partie touche à une face normale
768	>	' la face est automatiquement une face de volume.  Si c'est une coque, elle est traitée ailleurs.
769	>
770	>	'Dim interNormale As InterPoutreVolume
771	>	'Dim point1 As Object = Nothing
772	>	'swModel.ClosestDistance(sPoutre.swArete, sVol.SwFace, point1, Nothing)
773	>	'Dim xyzNormale() As Double = point1
774	>	'interNormale = sVol.AjouterInterPoutre(sPoutre, xyzNormale, 6) ' y'a des cas où ça pourrait ne pas être 1...
775	>	'sPoutre.lst_InterCoque.Add(interNormale)
776	>
777	>	End If
778	>
779		End If
780		Next
781
#	Line 697 | Line 785 | Module Intersections
785		Dim e As New SuperArete(sPoutre.swArete, True)
786		e.Colorer(3, 1, 0, 0)
787		sPoutre.Selectionner()
788	+	Err.Raise(520, "Gestion_Face_De_Section", "Une poutre ne peut être traitée car elle n'a pas été correctement définie.")
789		Exit Sub
790		End If
791
#	Line 717 | Line 806 | Module Intersections
806		' 2.2 le centroide est au point d'intersection
807		' déjà fait
808		' 2.3 la face est plane
809	+	Dim prop() As Double = Nothing
810	+
811		If Face1 IsNot Nothing Then
812	+	prop = prop1
813		If Not (Face1.estPlan Xor Face1.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
814		MsgBox("La face 1 n'est pas plane!")
815		Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
816		End If
817		End If
818		If Face2 IsNot Nothing Then
819	<	If Not (Face2.estPlan Xor Face2.estFauxPlan(prop1(2), prop1(3), prop1(4))) Then
819	>	prop = prop2
820	>	If Not (Face2.estPlan Xor Face2.estFauxPlan(prop2(2), prop2(3), prop2(4))) Then
821		MsgBox("La face 2 n'est pas plane!")
822		Err.Raise(513, , "Ne peut pas prendre une face non plane comme source de la section de la poutre")
823		End If
#	Line 758 | Line 851 | Module Intersections
851		' 3 - trouver l'inertie et l'aire, placer le point 3 de façon cohérente, updater l'attribut.
852		Dim Nom3 As String
853
854	<	Commun.MettreUnPoint(prop1(2) + prop1(18) / 1000, prop1(3) + prop1(19) / 1000, prop1(4) + prop1(20) / 1000, True)
855	<	Nom3 = RealConstant.RCCode.Creation3iemePoint(1)
856	<	sPoutre.SetAttributsDePoutre(False, Nom3, , , prop1(13), prop1(14), prop1(1), , , , , , , 1)
854	>	Commun.MettreUnPoint(prop(2) + prop(18) / 1000, prop(3) + prop(19) / 1000, prop(4) + prop(20) / 1000, True)
855	>	Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
856	>	Nom3 = RealConstant.RCCode.Creation3iemePoint(selmgr.GetSelectedObject(1))
857	>	sPoutre.SetAttributsDePoutre(False, Nom3, , , prop(13), prop(14), prop(1), , , , , , , 1)
858
859		' 4 créer une nouvelle instance de la classe interFacePoutre de tipe 5
860		Dim inter As New InterPoutreVolume
#	Line 792 | Line 886 | Module Intersections
886		Dim i As Integer
887		Dim premier2 As Boolean
888		Dim sVol As SlyFaceVolume
889	+	Dim SurSurface As Boolean = False
890
891		For Each sVol In lst_FaceVolume
892
798	–
893		' on cherche entre la coque et la poutre
894	<
895	<
802	<
803	<	If DetectFaceArete(sPoutre.swArete, sVol, xyz) Then
804	<
894	>	SurSurface = False
895	>	If DetectFaceArete(sPoutre.swArete, sVol, xyz, SurSurface) Then
896		For i = 0 To UBound(xyz) - 1 Step 3
897		' trouver le tipe d'intersection...
898
#	Line 823 | Line 914 | Module Intersections
914		T1 = T + 15 * Epsilon
915		T2 = T - 15 * Epsilon
916
826	–	Dim effacer As Double
917
918		If sPoutre.Evaluer(T1, PointTest) Then
919		' la valeur de T appartient à la poutre, maintenant on vérifie s'il appartient aussi à la coque
#	Line 834 | Line 924 | Module Intersections
924		End If
925
926		If sPoutre.Evaluer(T2, PointTest) Then
927	<	effacer = Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2))
927	>
928		If Distance(sVol.SwFace, PointTest(0), PointTest(1), PointTest(2)) < Epsilon Then
929		If Not premier2 Then tipe = 2 : premier2 = True Else tipe = 22
930		End If
#	Line 853 | Line 943 | Module Intersections
943
944		Next i ' autre point d'intersection
945
946	+	ElseIf SurSurface = True Then
947	+	' Si les 2 points de la courbe touchent à la surface alors  coupe-long
948	+	If Commun.Distance(sVol.SwFace, sPoutre.GetStartPoint()) < Epsilon AndAlso Commun.Distance(sVol.SwFace, sPoutre.GetEndPoint()) < Epsilon Then
949	+	inter = sVol.AjouterInterPoutre(sPoutre, xyz, 2)
950	+	sPoutre.lst_InterCoque.Add(inter)
951	+	End If
952		End If
953		premier2 = False ' reset
954
#	Line 972 | Line 1068 | Module Intersections
1068		' 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
1069
1070		Dim P1 As Object = Nothing, p2 As Object = Nothing
1071	<	If swModel.ClosestDistance(swArete, swFace, P1, P2) > Epsilon Then Return False
1071	>	If swModel.ClosestDistance(swArete, swFace, P1, p2) > Epsilon Then Return False
1072
1073		Dim swCurve As SldWorks.Curve
1074		Dim swSurf As SldWorks.Surface
#	Line 1080 | Line 1176 | Module Intersections
1176
1177
1178
1179	<	Private Function DetectFaceArete(ByRef swArete As SldWorks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double) As Boolean
1180	<	Dim swface As SldWorks.Face2
1181	<	Dim surarete As Boolean
1179	>	Private Function DetectFaceArete(ByRef swArete As sldworks.Edge, ByRef Slyface As SlyFaceVolume, ByRef xyz() As Double, Optional ByRef SurSurface As Boolean = False) As Boolean
1180	>	Dim swface As sldworks.Face2
1181	>
1182		For Each swface In Slyface.lst_Faces
1183		If DetectFaceArete(swArete, swface, xyz) Then
1184		Dim vEdges As Object
1185	<	Dim Arete As SldWorks.Edge
1185	>	Dim Arete As sldworks.Edge
1186		Dim inu() As Double = Nothing
1187
1188		vEdges = swface.GetEdges
#	Line 1094 | Line 1190 | Module Intersections
1190		For Each Arete In vEdges
1191		If DetectAreteArete(Arete, swArete, inu) Then
1192		' on a un type d'intersection entre une face et une arète...
1193	<	Dim swSurf As SldWorks.Surface
1193	>	Dim swSurf As sldworks.Surface
1194		Dim retval As Object
1195		Dim v(2) As Double
1196		Dim u(2) As Double
#	Line 1108 | Line 1204 | Module Intersections
1204		retval = swArete.Evaluate(retval(0))
1205		u(0) = retval(3) : u(1) = retval(4) : u(2) = retval(5)
1206		angle = Outils_Math.Angle2Vecteurs(u, v)
1207	<	MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense)
1207	>	'MsgBox(angle * 180 / Pi & "<-- angle sens --> " & swface.FaceInSurfaceSense & vbCr & "Aire = " & Slyface.Aire)
1208
1209	<	If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1210	<	Return True
1209	>
1210	>	'Si l'angle entre la normale de la face et la normale de la courbe est de 0
1211	>	' ou de pi/2 alors on a une SurSurface
1212	>	If Math.Abs(angle - Pi / 2) < 100 * Epsilon Or Math.Abs(angle) < 100 * Epsilon Then
1213	>	SurSurface = True
1214		Else
1215	<	surarete = True
1215	>	Return True
1216		End If
1217	+
1218	+	'If ((angle < (Pi / 2)) Xor swface.FaceInSurfaceSense()) Then
1219	+	'    Return True
1220	+	'Else
1221	+	'    SurSurface = True
1222	+	'End If
1223		End If
1224		Next
1225
1226
1227	<	If Not surarete Then Return True Else Return False
1227	>	If Not SurSurface Then Return True Else Return False
1228		End If
1229		Next
1230		End Function
#	Line 1378 | Line 1483 | Module Intersections
1483		Dim a1 As Integer
1484		Dim a2 As Integer
1485
1486	+	Try
1487	+	For a1 = 0 To lst_AretePoutre.Count - 1
1488	+	SlyArete1 = lst_AretePoutre.Item(a1)
1489	+	swArete1 = SlyArete1.swArete
1490	+
1491	+	If Not a1 = lst_AretePoutre.Count - 1 Then
1492	+	For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1493	+	SlyArete2 = lst_AretePoutre.Item(a2)
1494	+	swArete2 = SlyArete2.swArete
1495	+
1496	+	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1497	+	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1498	+
1499	+	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1500	+	Case 1 ' la première courbe est coupée
1501	+	pt = New InterPoutrePoutre
1502	+	pt.Arete = swArete1
1503	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1504	+	SlyArete1.AjouterPointAPAP(pt)
1505	+	pt = Nothing
1506	+	Case 2 ' la seconde courbe est coupée
1507	+	pt = New InterPoutrePoutre
1508	+	pt.Arete = swArete2
1509	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1510	+	SlyArete2.AjouterPointAPAP(pt)
1511	+	pt = Nothing
1512	+	Case 3 ' les doux poutres sont coupées
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	+	pt = New InterPoutrePoutre
1519	+	pt.Arete = swArete2
1520	+	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1521	+	SlyArete2.AjouterPointAPAP(pt)
1522	+	pt = Nothing
1523	+	End Select
1524	+	Next i
1525	+	End If
1526
1527	<	For a1 = 0 To lst_AretePoutre.Count - 2
1383	<	SlyArete1 = lst_AretePoutre.Item(a1)
1384	<	swArete1 = SlyArete1.swArete
1385	<
1386	<	For a2 = a1 + 1 To lst_AretePoutre.Count - 1
1387	<	SlyArete2 = lst_AretePoutre.Item(a2)
1388	<	swArete2 = SlyArete2.swArete
1389	<
1390	<	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1391	<	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1392	<
1393	<	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1394	<	Case 1 ' la première courbe est coupée
1395	<	pt = New InterPoutrePoutre
1396	<	pt.Arete = swArete1
1397	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1398	<	SlyArete1.AjouterPointAPAP(pt)
1399	<	pt = Nothing
1400	<	Case 2 ' la seconde courbe est coupée
1401	<	pt = New InterPoutrePoutre
1402	<	pt.Arete = swArete2
1403	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1404	<	SlyArete2.AjouterPointAPAP(pt)
1405	<	pt = Nothing
1406	<	Case 3 ' les doux poutres sont coupées
1407	<	pt = New InterPoutrePoutre
1408	<	pt.Arete = swArete1
1409	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1410	<	SlyArete1.AjouterPointAPAP(pt)
1411	<	pt = Nothing
1412	<	pt = New InterPoutrePoutre
1413	<	pt.Arete = swArete2
1414	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1415	<	SlyArete2.AjouterPointAPAP(pt)
1416	<	pt = Nothing
1417	<	End Select
1418	<	Next i
1527	>	Next a2
1528		End If
1529
1530	<	Next a2
1531	<
1532	<	Dim SlyArete3 As SlyAreteCoque
1533	<	For a2 = 0 To lst_AreteCoque.Count - 1
1534	<	SlyArete3 = lst_AreteCoque.Item(a2)
1535	<	swArete2 = SlyArete3.swArete
1536	<
1537	<	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1538	<	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1539	<
1540	<	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1541	<	Case 1 ' la première courbe est coupée
1542	<	pt = New InterPoutrePoutre
1543	<	pt.Arete = swArete1
1544	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1545	<	SlyArete1.AjouterPointAPAP(pt)
1546	<	pt = Nothing
1547	<	' seul la coque est coupée, elle sera découpée anyway.
1548	<	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1549	<	pt = New InterPoutrePoutre
1550	<	pt.Arete = swArete1
1551	<	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1552	<	SlyArete1.AjouterPointAPAP(pt)
1553	<	pt = Nothing
1554	<	End Select
1555	<	Next i
1447	<	End If
1448	<	Next a2
1530	>	Dim SlyArete3 As SlyAreteCoque
1531	>	For a2 = 0 To lst_AreteCoque.Count - 1
1532	>	SlyArete3 = lst_AreteCoque.Item(a2)
1533	>	swArete2 = SlyArete3.swArete
1534	>
1535	>	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1536	>	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1537	>
1538	>	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1539	>	Case 1 ' la première courbe est coupée
1540	>	pt = New InterPoutrePoutre
1541	>	pt.Arete = swArete1
1542	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1543	>	SlyArete1.AjouterPointAPAP(pt)
1544	>	pt = Nothing
1545	>	' seul la coque est coupée, elle sera découpée anyway.
1546	>	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1547	>	pt = New InterPoutrePoutre
1548	>	pt.Arete = swArete1
1549	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1550	>	SlyArete1.AjouterPointAPAP(pt)
1551	>	pt = Nothing
1552	>	End Select
1553	>	Next i
1554	>	End If
1555	>	Next a2
1556
1557	<	Dim slyarete4 As SlyAreteVol
1558	<	For a2 = 0 To lst_AreteVolume.Count - 1
1559	<	slyarete4 = lst_AreteVolume.Item(a2)
1560	<	swArete2 = slyarete4.swArete
1557	>	Dim slyarete4 As SlyAreteVol
1558	>	For a2 = 0 To lst_AreteVolume.Count - 1
1559	>	slyarete4 = lst_AreteVolume.Item(a2)
1560	>	swArete2 = slyarete4.swArete
1561	>
1562	>	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1563	>	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1564	>
1565	>	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1566	>	Case 1 ' la première courbe est coupée
1567	>	pt = New InterPoutrePoutre
1568	>	pt.Arete = swArete1
1569	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1570	>	SlyArete1.AjouterPointAPAP(pt)
1571	>	pt = Nothing
1572	>	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1573	>	pt = New InterPoutrePoutre
1574	>	pt.Arete = swArete1
1575	>	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1576	>	SlyArete1.AjouterPointAPAP(pt)
1577	>	pt = Nothing
1578	>	End Select
1579	>	Next i
1580	>	End If
1581	>	Next a2
1582
1455	–	If DetectAreteArete(swArete1, swArete2, xyz) Then ' intersection courbe-courbe
1456	–	For i = 0 To CInt((UBound(xyz) + 1) / 4) Step 4 ' si y'a plus d'une intersection entre les 2 courbes...
1583
1458	–	Select Case isIntersect_milieu(swArete1, swArete2, xyz(i), xyz(i + 1), xyz(i + 2))
1459	–	Case 1 ' la première courbe est coupée
1460	–	pt = New InterPoutrePoutre
1461	–	pt.Arete = swArete1
1462	–	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1463	–	SlyArete1.AjouterPointAPAP(pt)
1464	–	pt = Nothing
1465	–	Case 3 ' les doux poutres sont coupées, mais on note juste la deuxième
1466	–	pt = New InterPoutrePoutre
1467	–	pt.Arete = swArete1
1468	–	pt.x = xyz(i) : pt.y = xyz(i + 1) : pt.z = xyz(i + 2)
1469	–	SlyArete1.AjouterPointAPAP(pt)
1470	–	pt = Nothing
1471	–	End Select
1472	–	Next i
1473	–	End If
1474	–	Next a2
1584
1585	+	Next a1
1586	+	pt = Nothing
1587
1588	+	Catch
1589	+	MsgBox(" La première boucle n'a pas marchée")
1590	+	End Try
1591
1478	–	Next a1
1479	–	pt = Nothing
1592
1593	+	Dim count As Long = 0, count2 As Long = 0
1594	+	Try
1595
1596	+	'toutes les poutres ont des points où elles doivent être coupées
1597	+	' il suffit de couper.
1598	+	' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1599	+	Dim attr As sldworks.Attribute
1600	+	Dim swEnt As sldworks.Entity
1601	+
1602	+	For Each SlyArete1 In lst_AretePoutre
1603	+	If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1604	+	'1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1605	+
1606	+	count += 1
1607	+	' si c'est une droite
1608	+	If SlyArete1.IsLine Then
1609	+	Dim Pts(,) As Double
1610	+	Dim swSketch As sldworks.Sketch
1611	+	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1612	+
1613	+	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1614	+	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1615	+
1616	+	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1617	+	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1618	+	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1619	+	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1620	+	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1621	+	Next i
1622	+
1623	+	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1624	+	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1625	+	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1626	+
1627	+	' faut ordonner les points selon T...
1628	+	Dim j As Integer
1629	+	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1630	+	For i = 0 To max - 2
1631	+	For j = 0 To max - i - 1
1632	+	If Pts(3, j) > Pts(3, j + 1) Then
1633	+	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1634	+	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)
1635	+	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1636	+	End If
1637	+	Next j
1638	+	Next i
1639
1483	–	'toutes les poutres ont des points où elles doivent être coupées
1484	–	' il suffit de couper.
1485	–	' en réalité on suppress et on créé 2 ou plus courbes par dessus.
1486	–	Dim attr As SldWorks.Attribute
1487	–	Dim swEnt As SldWorks.Entity
1640
1641	<	For Each SlyArete1 In lst_AretePoutre
1642	<	If SlyArete1.lst_PtsInterAPAP.Count > 0 Then ' on coupe
1643	<	'1 - ordonner les points, de Tmin à Tmax et inclure les 2 extrémités de la poutre
1644	<
1645	<
1646	<	' si c'est une droite
1647	<	If SlyArete1.IsLine Then
1648	<	Dim Pts(,) As Double
1649	<	Dim swSketch As SldWorks.Sketch
1650	<	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1651	<
1652	<	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1653	<	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1654	<
1655	<	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1656	<	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1657	<	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1658	<	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1659	<	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1660	<	Next i
1641	>	For i = 0 To UBound(Pts, 2) - 1
1642	>	swModel.Insert3DSketch2(False)
1643	>	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
1644	>	swSketch = swModel.GetActiveSketch2
1645	>	swModel.Insert3DSketch2(False)
1646	>
1647	>	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1648	>	swModel.InsertCompositeCurve()
1649	>	Try
1650	>	count2 += 1
1651	>	UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1652	>	Catch
1653	>	MsgBox("UpdateAttribut n'a pas marché au compte # " & count2)
1654	>	End Try
1655	>	Next i
1656	>
1657	>
1658	>	Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1659	>
1660	>	Dim Pts(,) As Double
1661	>	Dim swSketch As sldworks.Sketch
1662	>	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1663	>
1664	>	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1665	>	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1666	>
1667	>	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1668	>	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1669	>	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1670	>	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1671	>	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1672	>	Next i
1673	>
1674	>	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1675	>	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1676	>	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1677	>
1678	>	' faut ordonner les points selon T...
1679	>	Dim j As Integer
1680	>	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1681	>	For i = 0 To max - 2
1682	>	For j = 0 To max - i - 1
1683	>	If Pts(3, j) > Pts(3, j + 1) Then
1684	>	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1685	>	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)
1686	>	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1687	>	End If
1688	>	Next j
1689	>	Next i
1690
1691	<	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1692	<	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1693	<	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1694	<
1695	<	' faut ordonner les points selon T...
1696	<	Dim j As Integer
1697	<	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1698	<	For i = 0 To max - 2
1699	<	For j = 0 To max - i - 1
1700	<	If Pts(3, j) > Pts(3, j + 1) Then
1701	<	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1702	<	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)
1703	<	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1691	>	Dim skSeg As sldworks.SketchSegment
1692	>	Dim x As Double, y As Double, z As Double
1693	>	Dim vretval As Object
1694	>	Dim useEdge As sldworks.SketchSegment
1695	>	Dim m As Integer
1696	>
1697	>
1698	>	For i = 0 To UBound(Pts, 2) - 1
1699	>	swModel.Insert3DSketch2(False)
1700	>	' sélectionner la edge originale
1701	>	swEnt = SlyArete1.swArete
1702	>	swEnt.Select4(False, Nothing)
1703	>	swModel.SketchUseEdge2(False)
1704	>	swSketch = swModel.GetActiveSketch2()
1705	>
1706	>	' 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.
1707	>	If i <> 0 Then ' premier pick, élimine ce qui est avant.
1708	>	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)
1709	>	skSeg.ConstructionGeometry = True ' ligne de construction
1710	>	swModel.ClearSelection2(True)
1711	>	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1712	>	SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1713	>	vretval = swSketch.GetSketchSegments
1714	>	useEdge = vretval(0) : m = 0
1715	>	Do Until useEdge.ConstructionGeometry = False
1716	>	m += 1
1717	>	useEdge = vretval(m)
1718	>	Loop
1719	>	useEdge.Select4(False, Nothing)
1720	>	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!!!!!
1721	>	skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1722	>	skSeg.ConstructionGeometry = True
1723		End If
1524	–	Next j
1525	–	Next i
1526	–
1527	–
1528	–	For i = 0 To UBound(Pts, 2) - 1
1529	–	swModel.Insert3DSketch2(False)
1530	–	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
1531	–	swSketch = swModel.GetActiveSketch2
1532	–	swModel.Insert3DSketch2(False)
1533	–
1534	–	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1535	–	swModel.InsertCompositeCurve()
1724
1725	<	UpdateAttributs(SlyArete1, i) 'ajouter les attributs de la vieille poutre sur la nouvelle
1726	<	Next i
1727	<
1728	<
1729	<	Else ' If SlyArete1.IsCircle Then  ' si c'est un cercle
1730	<
1731	<	Dim Pts(,) As Double
1732	<	Dim swSketch As SldWorks.Sketch
1733	<	ReDim Pts(3, SlyArete1.lst_PtsInterAPAP.Count + 1)
1734	<
1735	<	SlyArete1.GetStartPoint(Pts(0, 0), Pts(1, 0), Pts(2, 0)) ' le premier point
1736	<	Pts(3, 0) = SlyArete1.GetT(Pts(0, 0), Pts(1, 0), Pts(2, 0))
1737	<
1738	<	For i = 1 To SlyArete1.lst_PtsInterAPAP.Count
1739	<	Pts(0, i) = SlyArete1.lst_PtsInterAPAP.Item(i).x
1740	<	Pts(1, i) = SlyArete1.lst_PtsInterAPAP.Item(i).y
1741	<	Pts(2, i) = SlyArete1.lst_PtsInterAPAP.Item(i).z
1742	<	Pts(3, i) = SlyArete1.GetT(Pts(0, i), Pts(1, i), Pts(2, i))
1555	<	Next i
1556	<
1557	<	Dim max As Integer = SlyArete1.lst_PtsInterAPAP.Count + 1
1558	<	SlyArete1.GetEndPoint(Pts(0, max), Pts(1, max), Pts(2, max)) ' le dernier point
1559	<	Pts(3, max) = SlyArete1.GetT(Pts(0, max), Pts(1, max), Pts(2, max))
1560	<
1561	<	' faut ordonner les points selon T...
1562	<	Dim j As Integer
1563	<	Dim T1 As Double, T2 As Double, T3 As Double, T0 As Double
1564	<	For i = 0 To max - 2
1565	<	For j = 0 To max - i - 1
1566	<	If Pts(3, j) > Pts(3, j + 1) Then
1567	<	T0 = Pts(0, j) : T1 = Pts(1, j) : T2 = Pts(2, j) : T3 = Pts(3, j)
1568	<	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)
1569	<	Pts(0, j + 1) = T0 : Pts(1, j + 1) = T1 : Pts(2, j + 1) = T2 : Pts(3, j + 1) = T3
1725	>	If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1726	>	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)
1727	>	skSeg.ConstructionGeometry = True ' ligne de construction
1728	>	swModel.ClearSelection2(True)
1729	>
1730	>	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1731	>	SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1732	>	vretval = swSketch.GetSketchSegments
1733	>	useEdge = vretval(0) : m = 0
1734	>	Do Until useEdge.ConstructionGeometry = False
1735	>	m += 1
1736	>	useEdge = vretval(m)
1737	>	Loop
1738	>
1739	>	useEdge.Select4(False, Nothing)
1740	>	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!!!!!
1741	>	skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1742	>	skSeg.ConstructionGeometry = True
1743		End If
1571	–	Next j
1572	–	Next i
1573	–
1574	–	Dim skSeg As SldWorks.SketchSegment
1575	–	Dim x As Double, y As Double, z As Double
1576	–	Dim vretval As Object
1577	–	Dim useEdge As SldWorks.SketchSegment
1578	–	Dim m As Integer
1579	–
1580	–
1581	–	For i = 0 To UBound(Pts, 2) - 1
1582	–	swModel.Insert3DSketch2(False)
1583	–	' sélectionner la edge originale
1584	–	swEnt = SlyArete1.swArete
1585	–	swEnt.Select4(False, Nothing)
1586	–	swModel.SketchUseEdge2(False)
1587	–	swSketch = swModel.GetActiveSketch2()
1588	–
1589	–	' 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.
1590	–	If i <> 0 Then ' premier pick, élimine ce qui est avant.
1591	–	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)
1592	–	skSeg.ConstructionGeometry = True ' ligne de construction
1593	–	swModel.ClearSelection2(True)
1594	–	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1595	–	SlyArete1.Evaluer((Pts(3, i - 1) + Pts(3, i)) / 2, x, y, z)
1596	–	vretval = swSketch.GetSketchSegments
1597	–	useEdge = vretval(0) : m = 0
1598	–	Do Until useEdge.ConstructionGeometry = False
1599	–	m += 1
1600	–	useEdge = vretval(m)
1601	–	Loop
1602	–	useEdge.Select4(False, Nothing)
1603	–	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!!!!!
1604	–	skSeg = swModel.CreateLine2(0, 0, 0, x, y, 0)
1605	–	skSeg.ConstructionGeometry = True
1606	–	End If
1744
1745	<	If i <> UBound(Pts, 2) - 1 Then 'Second(pick)
1746	<	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)
1747	<	skSeg.ConstructionGeometry = True ' ligne de construction
1748	<	swModel.ClearSelection2(True)
1749	<
1613	<	' x et y doit être sélectionné sur un point avec un T inférieur au point d'intersection
1614	<	SlyArete1.Evaluer((Pts(3, i + 1) + Pts(3, i + 2)) / 2, x, y, z)
1615	<	vretval = swSketch.GetSketchSegments
1616	<	useEdge = vretval(0) : m = 0
1617	<	Do Until useEdge.ConstructionGeometry = False
1618	<	m += 1
1619	<	useEdge = vretval(m)
1620	<	Loop
1621	<
1622	<	useEdge.Select4(False, Nothing)
1623	<	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!!!!!
1624	<	skSeg = swModel.CreateLine2(0, 0.02, 0, x, y, 0)
1625	<	skSeg.ConstructionGeometry = True
1626	<	End If
1745	>	swModel.Insert3DSketch2(False)
1746	>	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1747	>	swModel.InsertCompositeCurve()
1748	>	UpdateAttributs(SlyArete1, i)
1749	>	Next i
1750
1751	<	swModel.Insert3DSketch2(False)
1629	<	swEnt = swSketch : swEnt.Select2(False, 1) ' doit avoir un mark de 1
1630	<	swModel.InsertCompositeCurve()
1631	<	UpdateAttributs(SlyArete1, i)
1632	<	Next i
1751	>	End If
1752
1634	–	End If
1753
1754	<	' tagger la vieille poutre pour ne pas la reprendre dans magic
1637	<	'Pour ça on ajoute un attribut pour ignorer...
1638	<	Dim nom As String
1639	<	Dim no As Integer
1640	<	Dim arete As SldWorks.Edge
1641	<
1642	<	arete = SlyArete1.swArete
1643	<	swEnt = arete
1644	<	nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1645	<	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1646	<	'attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1647	<	If attr Is Nothing Then
1648	<	Commun.ColorerAretes()
1649	<	swEnt = SlyArete1.swArete
1650	<	attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1651	<	End If
1754	>	' on met un attribut pour ignorer l'arète.  Les sommets devraient donc aussi être ignorés.
1755
1756	<	Dim p As SldWorks.Parameter
1654	<	p = attr.GetParameter("D1")
1655	<	p.SetDoubleValue(-9)
1656	<	p = attr.GetParameter("D2")
1657	<	p.SetDoubleValue(-9)
1658	<	p = attr.GetParameter("D3")
1659	<	p.SetDoubleValue(-9)
1660	<	p = attr.GetParameter("D4")
1661	<	p.SetDoubleValue(-9)
1756	>	SlyArete1.MettreAttributIgnorer()
1757
1758	<	If attr Is Nothing Then MsgBox("Pas marché")
1758	>	'Dim nom As String
1759	>	'Dim no As Integer
1760	>	'Dim arete As sldworks.Edge
1761	>	'arete = SlyArete1.swArete
1762	>	'swEnt = arete
1763	>	'nom = "Ignorer" & SlyArete1.nom & "_" & CStr(no)
1764	>	'attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1765	>	''attr = DefAttrRCP1.CreateInstance5(swModel, arete, nom, 0, 2) ' une deuxième instance du RCPoutre...
1766	>	'If attr Is Nothing Then
1767	>	'    Commun.ColorerAretes()
1768	>	'    swEnt = SlyArete1.swArete
1769	>	'    attr = swEnt.FindAttribute(Intersections.DefAttrRCP1, 0)
1770	>	'End If
1771	>
1772	>	'Dim p As sldworks.Parameter
1773	>	'p = attr.GetParameter("D1")
1774	>	'p.SetDoubleValue(-9)
1775	>	'p = attr.GetParameter("D2")
1776	>	'p.SetDoubleValue(-9)
1777	>	'p = attr.GetParameter("D3")
1778	>	'p.SetDoubleValue(-9)
1779	>	'p = attr.GetParameter("D4")
1780	>	'p.SetDoubleValue(-9)
1781
1782	+	'If attr Is Nothing Then MsgBox("Pas marché")
1783
1666	–	End If
1667	–	Next SlyArete1
1784
1785	+	End If
1786	+	Next SlyArete1
1787	+	Catch
1788	+	MsgBox("La seconde boucle n'a pas marchée  Compte: " & count)
1789	+	End Try
1790
1791		End Sub
1792
1793
1794	<	Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByRef i As Integer)
1795	<	Dim newArete As SldWorks.Edge
1796	<	Dim refcurve As SldWorks.ReferenceCurve
1797	<	Dim attr As SldWorks.Attribute
1798	<	Dim swfeat As SldWorks.Feature
1799	<
1794	>	Private Sub UpdateAttributs(ByRef slyarete1 As SlyAretePoutre, ByVal i As Integer)
1795	>	Dim newArete As sldworks.Edge
1796	>	Dim refcurve As sldworks.ReferenceCurve
1797	>	Dim attr As sldworks.Attribute = Nothing
1798	>	Dim swfeat As sldworks.Feature
1799	>	swModel.EditRebuild3()
1800		swfeat = swModel.FeatureByPositionReverse(0)
1801
1802	+	Debug.Print(swfeat.Name & "<-- Nom  Typename--> " & swfeat.GetTypeName)
1803	+
1804		refcurve = swfeat.GetSpecificFeature2()
1805		newArete = refcurve.GetFirstSegment()
1806
1807	<	Dim ParamM As SldWorks.Parameter
1808	<	Dim ParamS As SldWorks.Parameter
1809	<	Dim ParamI1 As SldWorks.Parameter
1810	<	Dim ParamI2 As SldWorks.Parameter
1811	<	Dim ParamD1 As SldWorks.Parameter
1812	<	Dim ParamD2 As SldWorks.Parameter
1813	<	Dim ParamD3 As SldWorks.Parameter
1814	<	Dim ParamD4 As SldWorks.Parameter
1815	<	Dim ParamD5 As SldWorks.Parameter
1816	<	Dim ParamD6 As SldWorks.Parameter
1817	<	Dim ParamAs As SldWorks.Parameter
1818	<	Dim ParamN3 As SldWorks.Parameter
1807	>	Dim ParamM As sldworks.Parameter
1808	>	Dim ParamS As sldworks.Parameter
1809	>	Dim ParamI1 As sldworks.Parameter
1810	>	Dim ParamI2 As sldworks.Parameter
1811	>	Dim ParamD1 As sldworks.Parameter
1812	>	Dim ParamD2 As sldworks.Parameter
1813	>	Dim ParamD3 As sldworks.Parameter
1814	>	Dim ParamD4 As sldworks.Parameter
1815	>	Dim ParamD5 As sldworks.Parameter
1816	>	Dim ParamD6 As sldworks.Parameter
1817	>	Dim ParamAs As sldworks.Parameter
1818	>	Dim ParamN3 As sldworks.Parameter
1819
1820	<	attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1820	>	Do While attr Is Nothing
1821	>	attr = Intersections.DefAttrRCP1.CreateInstance5(swModel, newArete, "Nouveau" & i & slyarete1.nom, 0, 2)
1822	>	i += 1
1823	>	Loop
1824
1825		ParamM = attr.GetParameter("M")
1826		ParamS = attr.GetParameter("S")
#	Line 1720 | Line 1846 | Module Intersections
1846		ParamD6.SetDoubleValue2(slyarete1.GetD6, 2, "")
1847		ParamAs.SetDoubleValue2(slyarete1.GetAireSection, 2, "")
1848
1849	<	Dim p As SldWorks.Parameter
1849	>	Dim p As sldworks.Parameter
1850		p = attr.GetParameter("N3")
1851		p.SetStringValue(slyarete1.GetN3)
1852		p = attr.GetParameter("X3")
#	Line 1730 | Line 1856 | Module Intersections
1856		p = attr.GetParameter("Z3")
1857		p.SetDoubleValue2(slyarete1.Z3, 2, "")
1858
1859	<	Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1859	>	' Commun.GererDossiers("Poutres", "Nouveau" & i & slyarete1.nom)
1860
1861		End Sub
1862
#	Line 1753 | Line 1879 | Module Intersections
1879		For Each coque2 In lst_FaceCoque
1880
1881		If DetectFaceFace(coque2, Face1, True, sketch) Then
1882	<	' création de l'instance de interFace-face entre coque et coque
1882	>	' création de l'instance de interFace-face entre coque et volume
1883	>
1884	>	Dim vSeg As Object = sketch.GetSketchSegments()
1885	>	If vSeg Is Nothing Then
1886	>	DetectFaceFace(coque2, Face1, True, sketch)
1887	>	vSeg = sketch.GetSketchSegments()
1888	>	If vSeg Is Nothing Then MsgBox("Problème") : Err.Raise(555)
1889	>	End If
1890	>
1891
1892
1893		interFF = New InterCoqueVolume
#	Line 1769 | Line 1903 | Module Intersections
1903		coque2.lst_InterCoqueVolume.Add(interFF)
1904		End If
1905
1906	<	Next
1907	<	Next
1906	>	Next coque2
1907	>	Next Face1
1908
1909
1910
#	Line 1847 | Line 1981 | Module Intersections
1981		Dim u() As Double, v() As Double
1982		Dim angle As Double
1983
1984	<	If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume()
1984	>	If interFF.AreteCoque Is Nothing Then interFF.QuelleAreteCoqueToucheVolume() : Dim effacer As New SuperArete(interFF.AreteCoque, True) ': effacer.Colorer(2, 0.7, 0, 0.7)
1985		swArete = interFF.AreteCoque
1986		T = Commun.GetTMilieu(swArete)
1987		vmid = swArete.Evaluate(T)
#	Line 1904 | Line 2038 | Module Intersections
2038		''' </summary>
2039		''' <remarks></remarks>
2040		Private Sub DécouperCoqueVolume()
2041	+	Static vc As Integer
2042	+	' Algo:
2043	+	' Pour chaque coque
2044	+	'   Si on doit couper la coque, alors on la coupe
2045	+	' On découpe la face du volume
2046	+	' ON identifie les faces internes
2047	+
2048
2049		Dim coque1 As SlyFaceCoque
2050		Dim interFF As InterCoqueVolume
2051
2052		' 1 - Pour toutes les coques
2053	+	Dim lst_face As New Collections.Generic.List(Of SlyFaceVolume)
2054
2055		For Each coque1 In Commun.lst_FaceCoque
2056	+
2057		For Each interFF In coque1.lst_InterCoqueVolume
2058	+
2059	+	'If interFF.Face_A_Plat Then
2060	+	'    If Not lst_face.Contains(interFF.sFaceVolume) Then
2061	+	'        lst_face.Add(interFF.sFaceVolume)
2062	+	'        interFF.DécouperFace_A_Plat()
2063	+	'    End If
2064	+
2065	+
2066		If interFF.FaceDeSection Then
2067		CoupeCoque1(interFF)
2068	+	If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes()
2069		Else
2070	<	interFF.GénérerSweep() ' étape 4
2071	<	interFF.DécouperVolume() ' étape 5
2072	<	If interFF.DoitCouperCoque Then ' on découpe aussi couper la coque selon le sweep
2070	>	interFF.DécouperVolume()
2071	>	' s'il y a plus d'une arête sur la coque qui touche au volume alors on doit découper la coque aussi
2072	>	' on sélectionne les 2 entités, puis on fait le sketch d'intersection et on évalue le nombre de courbes.
2073	>	Dim swBod1 As sldworks.Body2 = interFF.sFaceVolume.SwFace.GetBody() : swBod1.Select2(False, Nothing)
2074	>	Dim swBod2 As sldworks.Body2 = interFF.sFaceCoque.SwFace.GetBody() : swBod2.Select2(True, Nothing)
2075	>
2076	>	swModel.Sketch3DIntersections()
2077	>	Dim sketch As sldworks.Sketch = swModel.GetActiveSketch2
2078	>	swModel.InsertSketch2(True)
2079	>	Dim swfeatS As sldworks.Feature = swModel.FeatureByPositionReverse(0)
2080	>	swfeatS.Name = "Vérif_decoupage_coque#" & vc : vc += 1
2081	>
2082	>	If UBound(sketch.GetSketchSegments) > 1 Then
2083		interFF.DecouperCoque()
2084	<	interFF.QuelleAreteCoqueToucheVolume(True)
1923	<	Else
1924	<	interFF.QuelleAreteCoqueToucheVolume(False)
2084	>	interFF.QuelleAreteCoqueToucheVolume()
2085		End If
2086	<	If interFF.DerniereCoupe Then interFF.DecouperCoque()
2087	<	interFF.MarquerFacesInternes() ' étape 6
2086	>
2087	>	If Not Intersections.MultiDecoupageCoques Then interFF.MarquerFacesInternes() ' étape 6
2088
2089		End If
2090	<	Next
2090	>	Next interFF
2091		Next coque1
2092
2093
#	Line 1941 | Line 2101 | Module Intersections
2101		''' <param name="int">L'interFaceFace</param>
2102		''' <remarks></remarks>
2103		Private Sub CoupeCoque1(ByRef int As InterCoqueVolume)
1944	–	Dim sCoque As SlyFaceCoque
2104		Dim sVol As SlyFaceVolume
2105		Dim swFace As SldWorks.Face2
2106		Dim swent As SldWorks.Entity
#	Line 1956 | Line 2115 | Module Intersections
2115		swFace = sVol.SwFace
2116		sVol.Selectionner(0, False)
2117
2118	<	' b - lui mettre une esquisse
2119	<	swModel.InsertSketch2(True)
2118	>	'' b - lui mettre une esquisse
2119	>	'swModel.InsertSketch2(True)
2120
2121	<	' c - convertir l'esquisse déjà créée
2122	<	sketch = int.sketch
2123	<	swent = sketch
2124	<	swent.Select2(False, 0)
2125	<
2126	<	swModel.SketchUseEdge2(False)
2127	<
2128	<	' si la face est carrée
2129	<
2130	<	If swFace.GetEdgeCount = 4 Then
2131	<	' d - ajouter des lignes pour  compléter l'esquisse
2132	<	Dim longueur(3) As Double
2133	<
2134	<
2135	<	Dim vLine As Object
2136	<	Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2137	<	Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2138	<	Dim skSeg As SldWorks.SketchSegment
2139	<	vEdges = swFace.GetEdges()
2140	<	For Each swArete In vEdges
2141	<	ReDim Preserve aretes(i)
2142	<	aretes(i) = swArete
2143	<	i += 1
2144	<	Next
2145	<	For i = 0 To 3
2146	<	longueur(i) = Commun.GetLongueurArete(vEdges(i))
2147	<	Next i
2148	<	longueur = Ordonner(longueur, aretes)
2121	>	'' c - convertir l'esquisse déjà créée
2122	>	'sketch = int.sketch
2123	>	'swent = sketch
2124	>	'swent.Select2(False, 0)
2125	>
2126	>	'swModel.SketchUseEdge2(False)
2127	>
2128	>	'' si la face est carrée
2129	>
2130	>	'If swFace.GetEdgeCount = 4 Then
2131	>	'    ' d - ajouter des lignes pour  compléter l'esquisse
2132	>	'    Dim longueur(3) As Double
2133	>
2134	>
2135	>	'    Dim vLine As Object
2136	>	'    Dim line1 As SldWorks.SketchLine, line2 As SldWorks.SketchLine
2137	>	'    Dim P1 As SldWorks.SketchPoint, P2 As SldWorks.SketchPoint, P3 As SldWorks.SketchPoint, P4 As SldWorks.SketchPoint
2138	>	'    Dim skSeg As SldWorks.SketchSegment
2139	>	'    vEdges = swFace.GetEdges()
2140	>	'    For Each swArete In vEdges
2141	>	'        ReDim Preserve aretes(i)
2142	>	'        aretes(i) = swArete
2143	>	'        i += 1
2144	>	'    Next
2145	>	'    For i = 0 To 3
2146	>	'        longueur(i) = Commun.GetLongueurArete(vEdges(i))
2147	>	'    Next i
2148	>	'    longueur = Ordonner(longueur, aretes)
2149	>
2150	>	'    swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
2151	>	'    swModel.SketchUseEdge2(False)
2152	>	'    sketch = swModel.GetActiveSketch()
2153	>	'    vLine = sketch.GetSketchSegments()
2154	>	'    skSeg = vLine(0) : line1 = skSeg
2155	>	'    skSeg = vLine(1) : line2 = skSeg
2156	>
2157	>	'    P1 = line1.GetStartPoint2()
2158	>	'    P2 = line1.GetEndPoint2()
2159	>	'    P3 = line2.GetStartPoint2()
2160	>	'    P4 = line2.GetEndPoint2()
2161	>
2162	>	'    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
2163	>	'        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2164	>	'        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2165	>	'    Else ' ligne entre 1 et 4 & 2 et 3
2166	>	'        swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2167	>	'        swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2168	>	'    End If
2169	>	'Else
2170	>	'    sketch = swModel.GetActiveSketch()
2171	>	'End If
2172	>	'swModel.InsertSketch2(True)
2173
1991	–	swent = aretes(3) : swent.Select2(False, 0) ' on prend la plus grande arète
1992	–	swModel.SketchUseEdge2(False)
1993	–	sketch = swModel.GetActiveSketch()
1994	–	vLine = sketch.GetSketchSegments()
1995	–	skSeg = vLine(0) : line1 = skSeg
1996	–	skSeg = vLine(1) : line2 = skSeg
1997	–
1998	–	P1 = line1.GetStartPoint2()
1999	–	P2 = line1.GetEndPoint2()
2000	–	P3 = line2.GetStartPoint2()
2001	–	P4 = line2.GetEndPoint2()
2002	–
2003	–	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
2004	–	swModel.CreateLine2(P1.X, P1.Y, P1.Z, P3.X, P3.Y, P3.Z)
2005	–	swModel.CreateLine2(P2.X, P2.Y, P2.Z, P4.X, P4.Y, P4.Z)
2006	–	Else ' ligne entre 1 et 4 & 2 et 3
2007	–	swModel.CreateLine2(P1.X, P1.Y, P1.Z, P4.X, P4.Y, P4.Z)
2008	–	swModel.CreateLine2(P2.X, P2.Y, P2.Z, P3.X, P3.Y, P3.Z)
2009	–	End If
2010	–	Else
2011	–	sketch = swModel.GetActiveSketch()
2012	–	End If
2013	–	swModel.InsertSketch2(True)
2174
2175	+	'' e - splitter
2176	+	'swent = swFace : swent.Select2(False, 1)
2177	+	'swent = sketch : swent.Select2(True, 4)
2178	+	'swModel.InsertSplitLineProject(False, False)
2179
2016	–	' e - splitter
2017	–	swent = swFace : swent.Select2(False, 1)
2018	–	swent = sketch : swent.Select2(True, 4)
2019	–	swModel.InsertSplitLineProject(False, False)
2180
2181	+	sVol.Selectionner(32, False) 'swPart.Extension.SelectByID2("", "FACE", 0.05746341258515, 0.007456177698316, 0.04437034503314, False, 16, Nothing, 0)
2182	+	int.sFaceCoque.Selectionner(16, True) 'swPart.Extension.SelectByID2("", "FACE", 0.03921396269902, -0.007016448377556, 0, True, 32, Nothing, 0)
2183	+	swPart.FeatureManager.InsertSplitLineIntersect(7)
2184
2185		' f - mettre un FaceInterne sur les 2 faces résultantes.
2186		Dim swFeat As SldWorks.Feature
#	Line 2032 | Line 2195 | Module Intersections
2195		swFace1 = vFace(0)
2196		swFace2 = vFace(1)
2197
2198	<	swent = swFace1
2199	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2200	<	nom = "FaceInterneCoque1"
2201	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2202	<
2203	<	While attr Is Nothing
2204	<	no += 1
2205	<	nom = "FaceInterneCoque" & CStr(no)
2206	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2207	<	End While
2208	<	GererDossiers("FaceInternes", nom)
2209	<
2210	<	swent = swFace2
2211	<	attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2212	<	nom = "FaceInterneCoque1"
2213	<	If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2214	<
2215	<	While attr Is Nothing
2216	<	no += 1
2217	<	nom = "FaceInterneCoque" & CStr(no)
2218	<	attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2219	<	End While
2220	<	GererDossiers("FaceInternes", nom)
2198	>	sVol.AjouterFace(swFace1)
2199	>	sVol.AjouterFace(swFace2)
2200	>
2201	>	'Dim eFace As New SlyFaceVolume(swFace1, True)
2202	>	'eFace.MettreAttributFaceInterne(swFace1, , False)
2203	>
2204	>	'swent = swFace1
2205	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2206	>	'nom = "FaceInterneCoque1"
2207	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2) ' 0 = swThisconfig
2208	>
2209	>	'While attr Is Nothing
2210	>	'    no += 1
2211	>	'    nom = "FaceInterneCoque" & CStr(no)
2212	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace1, nom, 0, 2)
2213	>	'End While
2214	>	'GererDossiers("FaceInternes", nom)
2215	>
2216	>	'swent = swFace2
2217	>	'attr = swent.FindAttribute(Intersections.DefAttrFaceInterne, 0) ' si l'attribut existe déjà on pointe dessus.
2218	>	'nom = "FaceInterneCoque1"
2219	>	'If attr Is Nothing Then attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2) ' 0 = swThisconfig
2220	>
2221	>	'While attr Is Nothing
2222	>	'    no += 1
2223	>	'    nom = "FaceInterneCoque" & CStr(no)
2224	>	'    attr = Intersections.DefAttrFaceInterne.CreateInstance5(swModel, swFace2, nom, 0, 2)
2225	>	'End While
2226	>	'GererDossiers("FaceInternes", nom)
2227
2228
2229		End Sub
#	Line 2084 | Line 2253 | Module Intersections
2253		''' <param name="face1">Première face</param>
2254		''' <param name="face2">Seconde face</param>
2255		''' <param name="dessiner">Si l'on veut dessiner une esquisse contenant la courbe</param>
2256	<	''' <param name="Sketch">Si la première option est vrai, ce paramètre redonne l'esquisse qui contient la courbe</param>
2256	>	''' <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>
2257		''' <returns>Vrai si les faces se touchent</returns>
2258		''' <remarks>Si les 2 faces se touchent en un seul point alors ça retourne faux.</remarks>
2259		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
2260	<	' sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2261	<	Dim Surface1 As SldWorks.Surface
2262	<	Dim Surface2 As SldWorks.Surface
2260	>	'sub qui détecte si 2 faces se touchent et retourne vrai si c'est le cas.
2261	>	Dim Surface1 As sldworks.Surface
2262	>	Dim Surface2 As sldworks.Surface
2263		Dim curveArray As Object = Nothing
2264	<	Dim curve As SldWorks.Curve
2264	>	Dim curve As sldworks.Curve
2265		Dim ret As Boolean
2266		Dim boundsArray As Object = Nothing
2267		Dim bounds() As Double
#	Line 2113 | Line 2282 | Module Intersections
2282		If Not ret Then Return False
2283		bounds = boundsArray
2284
2116	–	'On Error GoTo faceSurFace
2285		Try
2286		curve = curveArray(0)
2287		Catch
2288	<	Debug.Write("On a une intersection où 2 faces sont sur la même surface...")
2289	<	Return False ' ouch... pas certain.
2288	>	Return False  'GoTo Fairesketch 'ne va pas toujours marcher, mais je n'ai rien de mieu pour l'instant...
2289	>	'MsgBox("On a une intersection où 2 faces sont sur la même surface...") ' en théorie...
2290	>	' ouch... pas certain.
2291		End Try
2292
2293
#	Line 2129 | Line 2298 | Module Intersections
2298		Dim vParam As Object
2299		vParam = curve.GetClosestPointOn(P1(0), P1(1), P1(2))  ' vparam(3) est le U
2300
2301	<	P1 = curve.Evaluate(vParam(3) + 100 * Epsilon) : Point1 = P1
2302	<	P2 = curve.Evaluate(vParam(3) - 100 * Epsilon) : Point2 = P2
2301	>	P1 = curve.Evaluate(vParam(3) + 100000 * Epsilon) : Point1(0) = P1(0) : Point1(1) = P1(1) : Point1(2) = P1(2)
2302	>	P2 = curve.Evaluate(vParam(3) - 100000 * Epsilon) : Point2(0) = P2(0) : Point2(1) = P2(1) : Point2(2) = P2(2)
2303
2304	<	If (Distance(face1, Point1(0), Point1(1), Point1(2)) < Epsilon) And (Distance(face2, Point1(0), Point1(1), Point1(2)) < Epsilon) Then
2305	<	ElseIf (Distance(face1, Point2(0), Point2(1), Point2(2)) < Epsilon) And (Distance(face2, Point2(0), Point2(1), Point2(2)) < Epsilon) Then
2304	>	' si p1 et p2 sont identiques alors on a un point D'intersection, ce que l'on ne veut pas
2305	>	If Distance(Point1, Point2) < 1000 * Epsilon Then Return False
2306	>
2307	>	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
2308	>	' return true
2309		Else
2310	<	Return False
2310	>
2311	>	Dim swent2 As sldworks.Entity
2312	>	Dim feat2 As sldworks.Feature
2313	>	swModel.Insert3DSketch2(False)
2314	>	swModel.ClearSelection2(True)
2315	>	'swent2 = face1 : swent2.Select2(False, 0)
2316	>	'swent2 = face2 : swent2.Select2(True, 0)
2317	>	Dim swBod1 As sldworks.Body2 = face1.GetBody : swBod1.Select2(False, Nothing)
2318	>	Dim swBod2 As sldworks.Body2 = face2.GetBody : swBod2.Select2(True, Nothing)
2319	>
2320	>	swModel.Sketch3DIntersections()
2321	>
2322	>	swModel.Insert3DSketch2(False)
2323	>	swModel.EditRebuild3()
2324	>	feat2 = swModel.FeatureByPositionReverse(0)
2325	>
2326	>	Debug.Print(feat2.Name)
2327	>
2328	>	Sketch = feat2.GetSpecificFeature2
2329	>	feat2.Name = "TouchePas" & CStr(Rnd())
2330	>	'MsgBox(face1.GetArea)
2331	>	Dim vSeg2 As Object = Sketch.GetSketchSegments()
2332	>	If vSeg2 Is Nothing Then
2333	>	swent2 = feat2
2334	>	swent2.Select(False)
2335	>	swModel.EditDelete()
2336	>	Return False
2337	>	Else
2338	>	If Math.Abs(bounds(0)) > 490 Then Return False ' se touchent à l'infini...
2339	>	Return True
2340	>	End If
2341	>
2342		End If
2343		End If
2344
2345	+	Fairesketch:
2346	+	Dim swent As sldworks.Entity
2347	+	Dim feat As sldworks.Feature
2348	+	swModel.Insert3DSketch2(False)
2349	+	swModel.ClearSelection2(True)
2350	+	'swent = face1 : swent.Select2(False, 0)
2351	+	'swent = face2 : swent.Select2(True, 0)
2352	+	Dim swBod1a As sldworks.Body2 = face1.GetBody : swBod1a.Select2(False, Nothing)
2353	+	Dim swBod2a As sldworks.Body2 = face2.GetBody : swBod2a.Select2(True, Nothing)
2354
2355	+	swModel.Sketch3DIntersections()
2356
2357	<	If dessiner Then
2358	<	Dim swent As SldWorks.Entity
2359	<	Dim feat As SldWorks.Feature
2360	<	swModel.Insert3DSketch2(False)
2361	<
2362	<	swent = face1 : swent.Select2(False, 0)
2363	<	swent = face2 : swent.Select2(True, 0)
2364	<	swModel.Sketch3DIntersections()
2365	<
2366	<	swModel.Insert3DSketch2(False)
2367	<	swModel.EditRebuild3()
2368	<	feat = swModel.FeatureByPositionReverse(0)
2369	<
2157	<	Sketch = feat.GetSpecificFeature2
2357	>	swModel.Insert3DSketch2(False)
2358	>	swModel.EditRebuild3()
2359	>	feat = swModel.FeatureByPositionReverse(0)
2360	>	Debug.Print(feat.Name)
2361	>	Sketch = feat.GetSpecificFeature2
2362	>	Dim vSeg As Object = Sketch.GetSketchSegments()
2363	>	If vSeg Is Nothing Then
2364	>	swent = feat
2365	>	swent.Select(False)
2366	>	swModel.EditDelete()
2367	>	Return False
2368	>	Else
2369	>	Return True
2370		End If
2371
2372		Return True
2161	–	'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.
2162	–
2163	–	'    Dim vEdge As Object, swAreteTest As SldWorks.Edge, xyz() As Double = Nothing, n As Integer
2164	–	'    Dim lst_T() As Double = Nothing, final() As Double
2165	–	'    Dim NewCourbe As SldWorks.Curve
2166	–
2167	–	'    For n = 1 To 2
2168	–	'        If n = 1 Then vEdge = face1.GetEdges() Else vEdge = face2.GetEdges()
2169	–	'        For f = 0 To UBound(vEdge)
2170	–	'            swAreteTest = vEdge(f)
2171	–	'            If DetectAreteArete(swAreteTest, curve, xyz) Then
2172	–
2173	–	'                If Not UBound(xyz) > 4 Then
2174	–	'                    vT = curve.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
2175	–	'                    T = vT(3)
2176	–
2177	–	'                    If lst_T Is Nothing Then ReDim lst_T(0) Else ReDim Preserve lst_T(UBound(lst_T) + 1)
2178	–	'                    lst_T(UBound(lst_T)) = T
2179	–	'                End If
2180	–	'            End If
2181	–	'        Next f
2182	–	'    Next n
2183	–
2184	–	'    final = trier(lst_T)
2185	–
2186	–	'    For i = 0 To UBound(final) Step 2
2187	–	'        Dim skseg As SldWorks.SketchSegment, angle As Double
2188	–
2189	–	'        Point1 = curve.Evaluate(final(i)) : Point2 = curve.Evaluate(final(i + 1))
2190	–	'        NewCourbe = curve.CreateTrimmedCurve2(Point1(0), Point1(1), Point1(2), Point2(0), Point2(1), Point2(2))
2191	–	'        If dessiner Then skseg = Commun.DessineCourbe(NewCourbe) : Sketch = skseg.GetSketch
2192	–	'        angle = AngleEntre2Faces(face1, face2, Point1) / 0.0174532925
2373
2194	–	'        'swApp.SendMsgToUser(" Courbe Droite " & angle)
2195	–	'    Next
2196	–
2197	–	'ElseIf curve.IsTrimmedCurve = False Then  ' courbe périodique... donc pas trimmée mais avec des bounds...
2198	–	'    If dessiner Then
2199	–	'        Commun.DessineCourbe(curve)
2200	–	'        Sketch = swModel.FeatureByPositionReverse(0)
2201	–	'    End If
2202	–
2203	–
2204	–	'Else
2205	–	'    If dessiner Then
2206	–	'        Commun.DessineCourbe(curve)
2207	–	'        Sketch = swModel.FeatureByPositionReverse(0)
2208	–	'    End If
2209	–	'End If
2210	–
2211	–	'Return True
2212	–	faceSurFace:  ' les 2 surfaces sont une sur l'autre...
2213	–	'Dim swent As SldWorks.Entity
2214	–	'Dim swent2 As SldWorks.Entity
2215	–	'swent = face1 : swent.Select2(False, 0)
2216	–	'swent2 = face2 : swent2.Select2(True, 0)
2217	–	'MsgBox("2 Faces avec une surface commune...")
2218	–	'Return True
2374		End Function
2375
2376
#	Line 2288 | Line 2443 | faceSurFace:  ' les 2 surfaces sont une
2443		End Function
2444
2445
2446	+	''' <summary>
2447	+	''' 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
2448	+	''' </summary>
2449	+	''' <remarks></remarks>
2450	+	Public Sub FairePreCarte()
2451	+
2452	+	Dim ligne_txt As String
2453	+	Dim fichier As System.IO.StreamWriter
2454	+	Dim EcartNodal As Double = Commun.ÉcartNodal
2455	+
2456	+	' si le fichier pog n'est pas encore créé, on doit le faire...
2457	+	If Commun.NomFichierPog = Nothing Then
2458	+	' la première ligne donne la boite englobante, la seconde la taille ENG
2459	+
2460	+	Dim path As String = Nothing
2461	+	Dim CMDialogl As New Windows.Forms.SaveFileDialog
2462	+	CMDialogl.DefaultExt = ".txt"
2463	+	CMDialogl.Filter = "Fichiers PoG (*.txt)|*.txt|Tout fichiers(*.*)|*.*"
2464	+
2465	+	CMDialogl.OverwritePrompt = True
2466	+	CMDialogl.Title = "Sélectionnez le fichier pour enregistrer les points"
2467	+	CMDialogl.ShowDialog()
2468	+	path = CMDialogl.FileName
2469	+	path = Txtpath(path) : Commun.NomFichierPog = path
2470	+	If path Is Nothing Or path = "" Then MsgBox("Aucun fichier sélectionné, sortie du programme!", MsgBoxStyle.Critical, "Erreur!")
2471	+
2472	+	fichier = System.IO.File.CreateText(path)
2473	+
2474	+	Dim vBox As Object = swPart.GetPartBox(True)
2475	+	Dim box() As Double = vBox
2476	+
2477	+	Dim centre(2) As Double ' le centre de la boite englobante
2478	+	Dim longueurs(2) As Double
2479	+
2480	+	centre(0) = (box(3) + box(0)) / 2
2481	+	centre(1) = (box(4) + box(1)) / 2
2482	+	centre(2) = (box(5) + box(2)) / 2
2483	+
2484	+	longueurs(0) = (box(3) - box(0)) * 1.25
2485	+	longueurs(1) = (box(4) - box(1)) * 1.25
2486	+	longueurs(2) = (box(5) - box(2)) * 1.25
2487	+
2488	+
2489	+	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)
2490	+	fichier.WriteLine(Replace(ligne_txt, ",", "."))
2491	+
2492	+	fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2493	+	Else
2494	+	' Le fichier pog existe déjà...
2495	+	fichier = System.IO.File.AppendText(Commun.NomFichierPog)
2496	+	'fichier.WriteLine(Replace(CStr(EcartNodal), ",", "."))
2497	+	End If
2498	+
2499	+
2500	+	' *** C'est ici que le fun se passe.
2501	+
2502	+
2503	+	' 1 - On parcourt toutes les faces, les listes sont déjà RE-crées, donc pas de multifaces
2504	+	For Each sFace As SlyFaceVolume In Commun.lst_FaceVolume
2505	+	sFace.MettrePointSurPOG(fichier)
2506	+	Next
2507	+
2508	+	For Each sFace As SlyFaceCoque In Commun.lst_FaceCoque
2509	+	sFace.MettrePointSurPOG(fichier)
2510	+	Next
2511	+
2512	+	' *** Fin
2513	+	fichier.Close()
2514	+	End Sub
2515	+
2516	+	''' <summary>
2517	+	''' Fonction qui compare 2 surfaces
2518	+	''' </summary>
2519	+	''' <param name="swSurf1">La première surface</param>
2520	+	''' <param name="swSurf2">La seconde</param>
2521	+	''' <returns>Vrai si les 2 surfaces sont identiques, faux sinon</returns>
2522	+	''' <remarks></remarks>
2523	+	Public Function ComparerSurfaces(ByRef swSurf1 As sldworks.Surface, ByRef swSurf2 As sldworks.Surface) As Boolean
2524	+	'swSurf1.GetBSurfParams2(True,False,
2525	+
2526	+
2527	+	If swSurf1.IsPlane And swSurf2.IsPlane Then
2528	+	Dim obj1 As Object = swSurf1.PlaneParams
2529	+	Dim obj2 As Object = swSurf2.PlaneParams
2530	+	For i As Integer = 0 To 2
2531	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2532	+	Next
2533	+	Return True
2534	+	ElseIf swSurf1.IsBlending And swSurf2.IsBlending Then
2535	+	' pas de blendingParams
2536	+
2537	+	ElseIf swSurf1.IsCone And swSurf2.IsCone Then
2538	+	Dim obj1 As Object = swSurf1.ConeParams
2539	+	Dim obj2 As Object = swSurf2.ConeParams
2540	+	For i As Integer = 0 To 7
2541	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2542	+	Next
2543	+	Return True
2544	+
2545	+	ElseIf swSurf1.IsCylinder And swSurf2.IsCylinder Then
2546	+	Dim obj1 As Object = swSurf1.CylinderParams
2547	+	Dim obj2 As Object = swSurf2.CylinderParams
2548	+	For i As Integer = 0 To 6
2549	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2550	+	Next
2551	+	Return True
2552	+	ElseIf swSurf1.IsForeign And swSurf2.IsForeign Then
2553	+	' ???
2554	+	ElseIf swSurf1.IsOffset And swSurf2.IsOffset Then
2555	+	' Pas de offsetParam
2556	+
2557	+	ElseIf swSurf1.IsParametric And swSurf2.IsParametric Then
2558	+	' pas de ParametricParams
2559	+
2560	+	ElseIf swSurf1.IsRevolved And swSurf2.IsRevolved Then
2561	+	' pas de revolvedparams
2562	+
2563	+	ElseIf swSurf1.IsSphere And swSurf2.IsSphere Then
2564	+	Dim obj1 As Object = swSurf1.SphereParams
2565	+	Dim obj2 As Object = swSurf2.SphereParams
2566	+
2567	+	For i As Integer = 0 To 3
2568	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2569	+	Next
2570	+	Return True
2571	+	ElseIf swSurf1.IsSwept And swSurf2.IsSwept Then
2572	+	' merde, il n'y a pas de Sweptparams
2573	+
2574	+	ElseIf swSurf1.IsTorus And swSurf2.IsTorus Then
2575	+	Dim obj1 As Object = swSurf1.TorusParams
2576	+	Dim obj2 As Object = swSurf2.TorusParams
2577	+
2578	+	For i As Integer = 0 To 7
2579	+	If Not Math.Abs(obj1(i) - obj2(i)) < Epsilon Then Return False
2580	+	Next
2581	+	Return True
2582	+	Else
2583	+	' faut quand même évaluer si on a la bonne chose...
2584	+	Try
2585	+	Dim pt As Object = swSurf1.Evaluate(0.5, 0.5, 0, 0)
2586	+	Dim obj As Object = swSurf1.GetClosestPointOn(pt(0), pt(1), pt(2)) ' x, y , z, U, V
2587	+	Dim obj1 As Object = swSurf1.EvaluateAtPoint(obj(0), obj(1), obj(2))
2588	+
2589	+	Dim objb As Object = swSurf2.GetClosestPointOn(pt(0), pt(1), pt(2)) ' x, y , z, U, V
2590	+	Dim obj2 As Object = swSurf2.EvaluateAtPoint(objb(0), objb(1), objb(2))
2591	+
2592	+	If Math.Abs(obj1(9) - obj2(9)) < Epsilon And Math.Abs(obj1(10) - obj2(10)) < Epsilon Then
2593	+	' c'est cheap.... mais
2594	+	Return True
2595	+	End If
2596	+	Return False
2597	+	Catch
2598	+	Return False
2599	+	End Try
2600	+
2601	+	End If
2602	+
2603	+	Return False
2604	+
2605	+
2606	+
2607	+	End Function
2608	+
2609
2610
2611		End Module

Diff Legend

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