ViewVC Help

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

root/REPOS_ERICCA/magicsld/Commun.vb

Comparing magicsld/Commun.vb (file contents):
Revision 48 by bournival, Wed Aug 22 21:18:12 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

#	Line 19 | Line 19 | Module Commun
19		Public lst_AreteVolume As New Collections.ObjectModel.Collection(Of SlyAreteVol) ' liste de courbes appartenant au volume
20		Public lst_AreteCoque As New Collections.ObjectModel.Collection(Of SlyAreteCoque) ' liste de courbes appartenant aux coques
21		Public lst_AretePoutre As New Collections.ObjectModel.Collection(Of SlyAretePoutre) ' liste de courbe libres
22	<	Public lst_FaceVolume As New Collections.ObjectModel.Collection(Of SlyFaceVolume)    ' liste de faces appartenant au volume
22	>	Public lst_FaceVolume As New Collections.Generic.List(Of SlyFaceVolume)    ' liste de faces appartenant au volume
23		Public lst_FaceCoque As New Collections.ObjectModel.Collection(Of SlyFaceCoque) ' liste de face libres
24		Public lst_SommetVolume As New Collections.ObjectModel.Collection(Of SlySommetVolume)
25		Public lst_SommetCoque As New Collections.ObjectModel.Collection(Of SlySommetCoque)
26		Public lst_sommetPoutre As New Collections.ObjectModel.Collection(Of SlySommetPoutre)
27
28	<	'Public lst_MiniPoutre As New Collection
28	>	Public ENG As Double
29	>	Private NameFichierPog As String
30	>
31		Public lst_AreteDoublon As New Collection
32
33	<	'Public Structure AretesDoublon
32	<	'    Dim AreteVol As EncapArete
33	<	'    Dim AreteCoque As EncapArete
34	<	'End Structure
33	>	Public OptionMettreNoteIntersection As Boolean = True
34
35
36		Public Structure sectionPoutre
#	Line 48 | Line 47 | Module Commun
47		End Structure
48
49
50	+
51		Public Enum tipe_e
52		Volume = 0
53		coque = 1
#	Line 55 | Line 55 | Module Commun
55		MiniPoutre = 3
56		End Enum
57
58	+	''' <summary>
59	+	''' L'écart nodal Global (ENG).
60	+	''' </summary>
61	+	''' <value></value>
62	+	''' <returns></returns>
63	+	''' <remarks>Doit être mémorisé ici pour pouvoir l'utiliser partout...</remarks>
64	+	Public Property ÉcartNodal() As Double
65	+	Get
66	+	Return ENG
67	+	End Get
68	+	Set(ByVal value As Double)
69	+	ENG = value
70	+	End Set
71	+	End Property
72	+
73	+	Public Property NomFichierPog() As String
74	+	Get
75	+	Return NameFichierPog
76	+	End Get
77	+	Set(ByVal value As String)
78	+	NameFichierPog = value
79	+	End Set
80	+	End Property
81
82
60	–	'Public Sub Preparer_pour_Magic()
61	–	'    ' routine qui (en en appelant d'autres) génère les SlyClasses finales (avec les conditions aux limites
62	–	'    ' mais elle n'enregistre pas les infos dans les propriétés des entités.
63	–
64	–	'    Dim TypeAnno As Long
65	–	'    Dim Anno As SldWorks.Annotation
66	–	'    Dim Note As SldWorks.Note
67	–	'    Dim swEnt As SldWorks.Entity
68	–	'    Dim vAttEntArr As Object
69	–	'    Dim reponse As Integer
70	–	'    Dim textAnno As String
71	–	'    Dim lst_cal As New Collection
72	–	'    Dim i As Integer
73	–	'    Dim e As Integer
74	–
75	–
76	–	'    Call Commun.GenererListes()
77	–	'puisque l'on relit les annotations, il faut effacer les anciennes,
78	–	'Dim s1 As SlyAreteVol
79	–	'For Each s1 In lst_AreteVolume
80	–	'    s1.ResetCL()
81	–	'Next
82	–	'Dim s2 As SlyAreteCoque
83	–	'For Each s2 In lst_AreteCoque
84	–	'    s2.ResetCL()
85	–	'Next
86	–	'Dim s3 As SlyAretePoutre
87	–	'For Each s3 In lst_AretePoutre
88	–	'    s3.ResetCL()
89	–	'Next
90	–	'Dim s4 As SlyFaceVol
91	–	'For Each s4 In lst_FaceVolume
92	–	'    s4.ResetCL()
93	–	'Next
94	–	'Dim s5 As SlyFaceCoque
95	–	'For Each s5 In lst_FaceCoque
96	–	'    s5.ResetCL()
97	–	'Next
98	–	'Dim s6 As SlySommetVolume
99	–	'For Each s6 In lst_SommetVolume
100	–	'    s6.ResetCL()
101	–	'Next
102	–	'Dim s7 As SlySommetCoque
103	–	'For Each s7 In lst_SommetCoque
104	–	'    s7.ResetCL()
105	–	'Next
106	–	'Dim s8 As SlySommetPoutre
107	–	'For Each s8 In lst_sommetPoutre
108	–	'    s8.ResetCL()
109	–	'Next
110	–
111	–	'Anno = swModel.GetFirstAnnotation2
112	–
113	–	'Do While Not Anno Is Nothing
114	–	'    TypeAnno = Anno.GetType
115	–	'    If TypeAnno = 6 Then
116	–
117	–	'        Note = Anno.IGetSpecificAnnotation
118	–	'        vAttEntArr = Anno.GetAttachedEntities2
119	–
120	–	'        For e = 0 To UBound(vAttEntArr)
121	–
122	–	'            swEnt = vAttEntArr(e)      ' 0 si on a juste une entité.
123	–
124	–	'            textAnno = Note.GetText
125	–	'            Select Case Mid(textAnno, 1, 3)
126	–	'                Case "Fx,", "Fy,", "Fz,", "Mx,", "My,", "Mz,", "Px,", "Py,", "Pz,", "Pn,", "Al,", "Au,", "Ar,", "Ux,", "Uy,", "Uz,", "Rx,", "Ry,", "Rz,", "Da,", "Dx,", "Dy,", "Dz,"
127	–	'                    'MsgBox "On a une bonne entité"
128	–
129	–	'                    Dim cl As New CaL
130	–	'                    'cl.swEnt = swEnt
131	–	'                    'cl.TypeCL = Mid(Note.GetText, 1, 2)
132	–	'                    For i = 4 To Len(textAnno) ' changer les virgules en point pour le val
133	–	'                        If Mid(textAnno, i, 1) = "," Then Mid(textAnno, i, 1) = "."
134	–	'                    Next i
135	–	'                    'cl.valeur = Val(Right(textAnno, Len(textAnno) - 3))
136	–
137	–	'                    Dim enti As Object
138	–	'                    enti = trouver(swEnt)
139	–	'                    enti.addCaL(Mid(textAnno, 1, 2), Val(Right(textAnno, Len(textAnno) - 3)))
140	–	'                Case Else
141	–	'                    reponse = MsgBox(" Une annotation a un texte qui n'est pas reconnu, " & Chr(13) & " si " & Note.GetText & Chr(13) & "doit être une condition limite alors il doit être modifié.", 65, "Condition aux limite non reconnue")
142	–	'                    If reponse = 3 Then Exit Sub
143	–	'            End Select
144	–	'        Next e
145	–
146	–	'    End If
147	–
148	–	'    Anno = Anno.GetNext3
149	–	'Loop
150	–
151	–
152	–	' maintenant on met des attributs sur les entités en fonction des conditions aux limites...
153	–
154	–	'For Each s1 In lst_AreteVolume
155	–	'    s1.MettreAttributPourConditionLimite()
156	–	'Next
157	–
158	–	'For Each s2 In lst_AreteCoque
159	–	'    s2.MettreAttributPourConditionLimite()
160	–	'Next
161	–
162	–	'For Each s3 In lst_AretePoutre
163	–	'    s3.MettreAttributPourConditionLimite()
164	–	'Next
165	–
166	–	'For Each s4 In lst_FaceVolume
167	–	'    s4.MettreAttributPourConditionLimite()
168	–	'Next
169	–
170	–	'For Each s5 In lst_FaceCoque
171	–	'    s5.MettreAttributPourConditionLimite()
172	–	'Next
173	–
174	–	'For Each s6 In lst_SommetVolume
175	–	'    s6.MettreAttributPourConditionLimite()
176	–	'Next
177	–
178	–	'For Each s7 In lst_SommetCoque
179	–	'    s7.MettreAttributPourConditionLimite()
180	–	'Next
181	–
182	–	'For Each s8 In lst_sommetPoutre
183	–	'    s8.MettreAttributPourConditionLimite()
184	–	'Next
185	–
186	–
187	–	' End Sub
188	–
83		Public Sub GenererListes(Optional ByVal ChercheAttribut As Boolean = True)
84		' sub qui créé les entités Sly... et le met dans les listes
85
#	Line 281 | Line 175 | Module Commun
175		vSupprime = feat.IsSuppressed
176		bSupprime = CBool(vSupprime)
177		If Not bSupprime Then  ' on vérifie que l'entité est pas supprimée
178	+	Try
179	+	Select Case feat.GetTypeName
180	+	Case "CompositeCurve", "3DSplineCurve" ', "Helix"  'le feature est une courbe libre
181	+
182	+	Dim refCourbe As sldworks.ReferenceCurve
183	+
184	+	refCourbe = feat.GetSpecificFeature2
185	+	swArete = refCourbe.GetFirstSegment
186	+	Do While Not swArete Is Nothing
187	+
188	+	If (Not Ignorer(swArete)) Then
189	+	Dim slyArete As SlyAretePoutre
190	+	slyArete = trouver(swArete, tipe_e.poutre)
191	+
192	+	If slyArete Is Nothing Then
193	+	slyArete = New SlyAretePoutre(swArete)
194	+	lst_AretePoutre.Add(slyArete)
195	+	End If
196
197	<	Select Case feat.GetTypeName
198	<	Case "CompositeCurve", "3DSplineCurve", "Helix"  'le feature est une courbe libre
199	<
200	<	Dim refCourbe As SldWorks.ReferenceCurve
201	<
202	<	refCourbe = feat.GetSpecificFeature2
203	<	swArete = refCourbe.GetFirstSegment
204	<	Do While Not swArete Is Nothing
293	<
294	<	If (Not Ignorer(swArete)) Then
295	<	Dim slyArete As SlyAretePoutre
296	<	slyArete = trouver(swArete, tipe_e.poutre)
297	<
298	<	If slyArete Is Nothing Then
299	<	slyArete = New SlyAretePoutre(swArete)
300	<	lst_AretePoutre.Add(slyArete)
301	<	End If
197	>	swSommet1 = swArete.GetStartVertex
198	>	If IsNothing(swSommet1) Then
199	>	'MsgBox("On a une courbe sans sommet")
200	>	Else
201	>	If trouver(swSommet1, tipe_e.poutre) Is Nothing Then
202	>	Dim slySommet As New SlySommetPoutre(swSommet1)
203	>	lst_sommetPoutre.Add(slySommet)
204	>	End If
205
206	<	swSommet1 = swArete.GetStartVertex
207	<	If IsNothing(swSommet1) Then
208	<	'MsgBox("On a une courbe sans sommet")
209	<	Else
210	<	If trouver(swSommet1, tipe_e.poutre) Is Nothing Then
308	<	Dim slySommet As New SlySommetPoutre(swSommet1)
309	<	lst_sommetPoutre.Add(slySommet)
206	>	swSommet2 = swArete.GetEndVertex
207	>	If trouver(swSommet2, tipe_e.poutre) Is Nothing Then
208	>	Dim slySommet As New SlySommetPoutre(swSommet2)
209	>	lst_sommetPoutre.Add(slySommet)
210	>	End If
211		End If
212
213	<	swSommet2 = swArete.GetEndVertex
214	<	If trouver(swSommet2, tipe_e.poutre) Is Nothing Then
215	<	Dim slySommet As New SlySommetPoutre(swSommet2)
216	<	lst_sommetPoutre.Add(slySommet)
217	<	End If
213	>	' on cherche s'il n'y aurait pas un attribut sur la poutre
214	>	'If ChercheAttribut Then
215	>	Try
216	>	ent = swArete
217	>	attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
218	>	slyArete.swAttribute = attr
219	>	If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
220	>	'Dim xyz() As Double
221	>	'xyz = slyarete.GetPoint3
222	>	'slyarete.X3 = xyz(0)
223	>	'slyarete.y3 = xyz(1)
224	>	'slyarete.z3 = xyz(2)
225	>	Catch ex As Exception
226	>	MsgBox("Une poutre sans attributs est détectée dans le modèle!")
227	>	End Try
228	>
229		End If
230
231	<	' on cherche s'il n'y aurait pas un attribut sur la poutre
232	<	'If ChercheAttribut Then
321	<	Try
322	<	ent = swArete
323	<	attr = ent.FindAttribute(Intersections.DefAttrRCP1, 0)
324	<	slyArete.swAttribute = attr
325	<	If Left(attr.GetName, 4) = "Mini" Then swArete.Display(2, 1, 0, 1, True) Else swArete.Display(2, 0, 1, 0, True)
326	<	'Dim xyz() As Double
327	<	'xyz = slyarete.GetPoint3
328	<	'slyarete.X3 = xyz(0)
329	<	'slyarete.y3 = xyz(1)
330	<	'slyarete.z3 = xyz(2)
331	<	Catch ex As Exception
332	<	MsgBox("Une poutre sans attributs est détectée dans le modèle!")
333	<	End Try
231	>	swArete = Nothing
232	>	swArete = refCourbe.GetNextSegment
233
234	<	End If
234	>	Loop
235
337	–	swArete = Nothing
338	–	swArete = refCourbe.GetNextSegment
339	–
340	–	Loop
236
237	+	Case "PLine", "ExtruRefSurface", "RevolvRefSurf", "SweepRefSurface", "BlendRefSurface", "OffsetRefSurface", "ExtendRefSurface", "PlanarSurface", "RadiateRefSurface", "MidRefSurface", "FillRefSurface", "RefSurface"
238
239	<	Case "PLine", "ExtruRefSurface", "RevolvRefSurf", " SweepRefSurface", "BlendRefSurface", "OffsetRefSurface", "ExtendRefSurface", "PlanarSurface", "RadiateRefSurface", "MidRefSurface", "FillRefSurface"
240	<	' le feature est une surface libre, certains types de surface n'ont pas été gardés car
345	<	' leur face appartient à un autre feature ou parce qu'il sont impossible à retrouver dans un multimodèle
239	>	' le feature est une surface libre, certains types de surface n'ont pas été gardés car
240	>	' leur face appartient à un autre feature ou parce qu'il sont impossible à retrouver dans un multimodèle
241
242
243	<	' Attention, si c'est une PLine ça peut prendre un volume
243	>	' Attention, si c'est une PLine ça peut prendre un volume
244
245	<	Dim body As SldWorks.Body2
246	<	Dim vFaces As Object
247	<	Dim vf As Object
248	<	Dim slyFace As SlyFaceCoque
245	>	Dim body As sldworks.Body2
246	>	Dim vFaces As Object
247	>	Dim vf As Object
248	>	Dim slyFace As SlyFaceCoque
249	>	Dim ShellBody As sldworks.Body2
250
251	<	vFaces = feat.GetFaces
252	<	If Not vFaces Is Nothing Then
253	<	For Each vf In vFaces
254	<	swFace = vf
255	<	body = swFace.GetBody
251	>	vFaces = feat.GetFaces
252	>	If Not vFaces Is Nothing Then
253	>	For Each vf In vFaces
254	>	swFace = vf
255	>	ShellBody = swFace.GetBody : If ShellBody.Visible = False Then Continue For
256	>	body = swFace.GetBody
257
258
259	<	If Not (body.GetType = swconst.swBodyType_e.swSolidBody) Then  ' si le body est quelquechose de solide alors on a le feature Pline d'un solide....
259	>	If Not (body.GetType = swconst.swBodyType_e.swSolidBody) Then  ' si le body est quelquechose de solide alors on a le feature Pline d'un solide....
260
261	<	slyFace = trouver(swFace, tipe_e.coque)
262	<	If slyFace Is Nothing Then
261	>	slyFace = trouver(swFace, tipe_e.coque)
262	>	If slyFace Is Nothing Then
263
264	<	slyFace = New SlyFaceCoque(swFace)
265	<	lst_FaceCoque.Add(slyFace)
266	<	End If
264	>	slyFace = New SlyFaceCoque(swFace)
265	>	lst_FaceCoque.Add(slyFace)
266	>	End If
267
268
269	<	' ***** détection des attributs des coques
270	<	attr = Nothing
271	<	If ChercheAttribut Then
272	<	Try
273	<	ent = swFace
274	<	attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
275	<	slyFace.swAttribute = attr
276	<	Catch ex As Exception
277	<	MsgBox("Une coque sans attributs est détectée dans le modèle!")
278	<	End Try
279	<
280	<	If IsNothing(attr) Then  ' on a trouvé un attribut de coque
281	<	'il n'y a pas encore d'attributs sur cette coque.
282	<	'MsgBox("Le putain d'attribut n'a pas été détecté!")
269	>	' ***** détection des attributs des coques
270	>	attr = Nothing
271	>	If ChercheAttribut Then
272	>	Try
273	>	ent = swFace
274	>	attr = ent.FindAttribute(Intersections.DefAttrRCCoque, 0)
275	>	slyFace.swAttribute = attr
276	>	Catch ex As Exception
277	>	MsgBox("Une coque sans attributs est détectée dans le modèle!")
278	>	End Try
279	>
280	>	If IsNothing(attr) Then  ' on a trouvé un attribut de coque
281	>	'il n'y a pas encore d'attributs sur cette coque.
282	>	'MsgBox("Le putain d'attribut n'a pas été détecté!")
283	>	End If
284		End If
387	–	End If
388	–
389	–	swLoop = swFace.GetFirstLoop
390	–	Do While Not swLoop Is Nothing
391	–	swCoArete = swLoop.GetFirstCoEdge
392	–	Dim coa As Integer
393	–	For coa = 0 To swLoop.GetEdgeCount - 1
394	–
395	–	swArete = swCoArete.GetEdge
396	–
397	–	If (Not Ignorer(swArete)) Then
398	–	If trouver(swArete, tipe_e.coque) Is Nothing Then
399	–	Dim slyArete As New SlyAreteCoque(swArete)
400	–	lst_AreteCoque.Add(slyArete)
401	–	End If
285
286	<	swSommet1 = swArete.GetStartVertex
287	<	If IsNothing(swSommet1) Then
288	<	'MsgBox("On a une courbe sans sommet")
289	<	Else
290	<	If trouver(swSommet1, tipe_e.coque) Is Nothing Then
291	<	Dim slySommet As New SlySommetCoque(swSommet1)
292	<	lst_SommetCoque.Add(slySommet)
286	>	swLoop = swFace.GetFirstLoop
287	>	Do While Not swLoop Is Nothing
288	>	swCoArete = swLoop.GetFirstCoEdge
289	>	Dim coa As Integer
290	>	For coa = 0 To swLoop.GetEdgeCount - 1
291	>
292	>	swArete = swCoArete.GetEdge
293	>
294	>	If (Not Ignorer(swArete)) Then
295	>	If trouver(swArete, tipe_e.coque) Is Nothing Then
296	>	Dim slyArete As New SlyAreteCoque(swArete)
297	>	lst_AreteCoque.Add(slyArete)
298		End If
299
300	<	swSommet2 = swArete.GetEndVertex
301	<	If trouver(swSommet2, tipe_e.coque) Is Nothing Then
302	<	Dim slySommet As New SlySommetCoque(swSommet2)
303	<	lst_SommetCoque.Add(slySommet)
300	>	swSommet1 = swArete.GetStartVertex
301	>	If IsNothing(swSommet1) Then
302	>	'MsgBox("On a une courbe sans sommet")
303	>	Else
304	>	If trouver(swSommet1, tipe_e.coque) Is Nothing Then
305	>	Dim slySommet As New SlySommetCoque(swSommet1)
306	>	lst_SommetCoque.Add(slySommet)
307	>	End If
308	>
309	>	swSommet2 = swArete.GetEndVertex
310	>	If trouver(swSommet2, tipe_e.coque) Is Nothing Then
311	>	Dim slySommet As New SlySommetCoque(swSommet2)
312	>	lst_SommetCoque.Add(slySommet)
313	>	End If
314		End If
315	+
316	+	swCoArete = swCoArete.GetNext
317		End If
318	+	Next coa ' fin de loop sur les coaretes
319
320	<	swCoArete = swCoArete.GetNext
321	<	End If
322	<	Next coa ' fin de loop sur les coaretes
320	>	swLoop = swLoop.GetNext
321	>	Loop ' fin loop sur loop
322	>	Else
323	>	'MsgBox("On vient de retirer une PLine appartenant à un volume!", MsgBoxStyle.Exclamation)
324	>	End If
325	>	Next vf
326	>	End If
327
328	<	swLoop = swLoop.GetNext
329	<	Loop ' fin loop sur loop
330	<	Else
331	<	'MsgBox("On vient de retirer une PLine appartenant à un volume!", MsgBoxStyle.Exclamation)
332	<	End If
333	<	Next vf
429	<	End If
328	>	Case Else ' n'est pas un feature intéressant...
329	>	' rien
330	>	End Select
331	>	Catch
332	>	MsgBox("Générer liste n'a pas marché sur le feature: " & feat.Name)
333	>	End Try
334
431	–	Case Else ' n'est pas un feature intéressant...
432	–	' rien
433	–	End Select
335		End If ' fin du if sur la suppression du feature
336		feat = feat.GetNextFeature
337		Loop
#	Line 523 | Line 424 | Module Commun
424
425		End Sub
426
427	<	Public Function getNom(ByRef swEnt As SldWorks.Entity) As String
427	>	Public Overloads Function getNom(ByRef swEnt As sldworks.Entity) As String
428		getNom = swPart.GetEntityName(swEnt)
429		End Function
430
431	<	Public Function getNom(ByRef swFace As SldWorks.Face2) As String
432	<	Dim swEnt As SldWorks.Entity
431	>	Public Overloads Function getNom(ByRef swFace As sldworks.Face2) As String
432	>	Dim swEnt As sldworks.Entity
433		swEnt = swFace
434		getNom = swPart.GetEntityName(swEnt)
435		End Function
436
437	<	Public Function getNom(ByRef swArete As SldWorks.Edge) As String
438	<	Dim swEnt As SldWorks.Entity
437	>	Public Overloads Function getNom(ByRef swArete As sldworks.Edge) As String
438	>	Dim swEnt As sldworks.Entity
439		swEnt = swArete
440		getNom = swPart.GetEntityName(swEnt)
441		End Function
442
443	<	Public Function getNom(ByRef swSommet As SldWorks.Vertex) As String
444	<	Dim swEnt As SldWorks.Entity
443	>	Public Overloads Function getNom(ByRef swSommet As sldworks.Vertex) As String
444	>	Dim swEnt As sldworks.Entity
445		swEnt = swSommet
446		getNom = swPart.GetEntityName(swEnt)
447		End Function
#	Line 548 | Line 449 | Module Commun
449		Public Sub GererDossiers(ByRef nomDossier As String, ByRef NomFeature As String)
450		' déplace un feature dans un dossier ( et créé le dossier si ce n'est pas déjà fait)
451
551	–
452		Static copienom As String
453		Dim swFeat As SldWorks.Feature
454		Dim ok As Boolean
#	Line 566 | Line 466 | Module Commun
466
467		'on mémorise tout ce qui est sélectionné
468		Dim lst_selection As New Collection
469	<	Dim selMgr As SldWorks.SelectionMgr
469	>	Dim selMgr As sldworks.SelectionMgr
470		selMgr = swModel.SelectionManager
471
472		For j = 1 To selMgr.GetSelectedObjectCount
#	Line 587 | Line 487 | Module Commun
487		j = j + 1
488		If swFeat.GetTypeName = "ProfileFeature" Or swFeat.GetTypeName = "3DProfileFeature" Then swFeat = swModel.FeatureByPositionReverse(j) Else ok = True
489		End While
490	+
491		swFeat.Select(False)
492		folder = featMgr.InsertFeatureTreeFolder2(1)
493		If Not folder Is Nothing Then folder.Name = nomDossier
#	Line 623 | Line 524 | suite:
524
525		End Sub
526
527	<	Public Function trouver(ByRef swface As SldWorks.Face2, ByRef tipe As Commun.tipe_e) As Object
528	<	Dim face As SldWorks.Face2
527	>	Public Overloads Function trouver(ByRef swface As sldworks.Face2, ByRef tipe As Commun.tipe_e) As Object
528	>	Dim face As sldworks.Face2
529
530		Select Case tipe
531		Case tipe_e.Volume
#	Line 650 | Line 551 | suite:
551		Return Nothing ' devrait pas passer par ici...
552		End Function
553
554	<	Public Function trouver(ByRef swEnt As SldWorks.Entity) As Object
555	<	Dim face As SldWorks.Face2
554	>	Public Overloads Function trouver(ByRef swEnt As sldworks.Entity) As Object
555	>	Dim face As sldworks.Face2
556		Select Case swEnt.GetType()
557		Case swconst.swSelectType_e.swSelFACES
558	<	Dim swface As SldWorks.Face2
558	>	Dim swface As sldworks.Face2
559		Dim f As SlyFaceVolume
560		swface = swEnt
561		For Each f In lst_FaceVolume
#	Line 673 | Line 574 | suite:
574
575
576		Case swconst.swSelectType_e.swSelEDGES
577	<	Dim swArete As SldWorks.Edge
577	>	Dim swArete As sldworks.Edge
578		swArete = swEnt
579		Dim test As Object
580		test = Commun.trouver(swArete, tipe_e.Volume)
#	Line 686 | Line 587 | suite:
587
588
589		Case swconst.swSelectType_e.swSelVERTICES
590	<	Dim swSommet As SldWorks.Vertex
590	>	Dim swSommet As sldworks.Vertex
591		swSommet = swEnt
592
593		Dim s1 As SlySommetVolume
#	Line 718 | Line 619 | suite:
619		''' <param name="Genlist">Une option pour accélérer le calcul dans certaines circonstances</param>
620		''' <returns>Le pointeur sur l'entité ou Nothing si elle est pas trouvée</returns>
621		''' <remarks></remarks>
622	<	Public Function trouver(ByRef swArete As SldWorks.Edge, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
622	>	Public Overloads Function trouver(ByRef swArete As sldworks.Edge, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
623
624		Select Case tipe
625		Case tipe_e.Volume
#	Line 731 | Line 632 | suite:
632		If Not Genlist Then
633		Dim Testarete As New SuperArete(swArete, True)
634		For Each s In lst_AreteVolume
635	<	If Testarete.Comparer(s.swArete) Then Return s
635	>	If Testarete.comparer(s.swArete) Then Return s
636		Next s
637		End If
638
#	Line 759 | Line 660 | suite:
660		Return Nothing
661		End Function
662
663	<	Public Function trouver(ByRef Arete As SuperArete, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
663	>	Public Overloads Function trouver(ByRef Arete As SuperArete, ByRef tipe As Commun.tipe_e, Optional ByRef Genlist As Boolean = False) As Object
664
665		Select Case tipe
666		Case tipe_e.Volume
#	Line 767 | Line 668 | suite:
668		If Not Genlist Then
669		Dim s As SlyAreteVol
670		For Each s In lst_AreteVolume
671	<	If Arete.Comparer(s.swArete) Then Return s
671	>	If Arete.comparer(s.swArete) Then Return s
672		Next s
673		End If
674
675		Case tipe_e.coque
676		Dim s As SlyAreteCoque
677		For Each s In lst_AreteCoque
678	<	If Arete.Comparer(s.swArete) Then Return s
678	>	If Arete.comparer(s.swArete) Then Return s
679		Next s
680		End Select
681
682		Return Nothing
683		End Function
684
685	<	Public Function trouver(ByRef swSommet As SldWorks.Vertex, ByRef tipe As Commun.tipe_e) As Object
685	>	Public Overloads Function trouver(ByRef swSommet As sldworks.Vertex, ByRef tipe As Commun.tipe_e) As Object
686
687		Select Case tipe
688		Case tipe_e.Volume
#	Line 866 | Line 767 | suite:
767		MathUtil = swApp.GetMathUtility
768		point(0) = p(0)
769		point(1) = p(1)
770	<	point(2) = 0
770	>	If UBound(p) = 1 Then point(2) = 0 Else point(2) = p(2)
771		vPoint = point
772		MathP = MathUtil.CreatePoint(vPoint)
773
#	Line 897 | Line 798 | suite:
798
799
800
801	<	Public Function Distance(ByRef somm As SldWorks.Vertex, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
801	>	Public Overloads Function Distance(ByRef somm As sldworks.Vertex, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
802		Dim vpoints As Object
803		Dim dPoint() As Double
804		Dim temp As Double
#	Line 909 | Line 810 | suite:
810
811		End Function
812
813	<	Public Function Distance(ByRef Arete As SldWorks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
813	>	Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
814		Dim vpoints As Object
815		Dim dPoint() As Double
816		Dim temp As Double
#	Line 922 | Line 823 | suite:
823
824		End Function
825
826	<	Public Function Distance(ByRef Arete As SldWorks.Edge, ByRef P() As Double) As Double
826	>	Public Overloads Function Distance(ByRef Arete As sldworks.Edge, ByRef P() As Double) As Double
827		Dim vpoints As Object
828		Dim dPoint() As Double
829		Dim temp As Double
#	Line 936 | Line 837 | suite:
837		End Function
838
839
840	<	Public Function Distance(ByRef Courbe As SldWorks.Curve, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
840	>	Public Overloads Function Distance(ByRef Courbe As sldworks.Curve, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
841		Dim vpoints As Object
842		Dim dPoint() As Double
843		Dim temp As Double
#	Line 948 | Line 849 | suite:
849		Return Math.Sqrt(temp)
850		End Function
851
852	+	Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal xyz() As Double) As Double
853	+	Return Distance(Face, xyz(0), xyz(1), xyz(2))
854	+	End Function
855
856	<	Public Function Distance(ByRef Face As SldWorks.Face2, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
856	>	Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
857		Dim vpoints As Object
858		Dim dPoint() As Double
859		Dim temp As Double
#	Line 962 | Line 866 | suite:
866
867		End Function
868
869	+	Public Overloads Function Distance(ByRef Face As SuperFace, ByVal x As Double, ByVal y As Double, ByVal z As Double) As Double
870	+	Dim vpoints As Object
871	+	Dim dPoint() As Double
872	+	Dim temp As Double
873	+	vpoints = Face.SwFace.GetClosestPointOn(x, y, z)
874	+	dPoint = vpoints
875	+
876	+	temp = (dPoint(0) - x) * (dPoint(0) - x) + (dPoint(1) - y) * (dPoint(1) - y) + (dPoint(2) - z) * (dPoint(2) - z)
877
878	<	Public Function Distance(ByRef Face As SldWorks.Face2, ByRef sommet As SldWorks.Vertex) As Double
878	>	Return Math.Sqrt(temp)
879	>
880	>	End Function
881	>
882	>
883	>	Public Overloads Function Distance(ByRef Face As sldworks.Face2, ByRef sommet As sldworks.Vertex) As Double
884		Dim vpoints As Object
885		Dim dPoint() As Double
886		Dim temp As Double
#	Line 984 | Line 901 | suite:
901		End Function
902
903
904	<	Public Function distance(ByRef s1 As SldWorks.Vertex, ByRef s2 As SldWorks.Vertex) As Double
904	>	Public Overloads Function distance(ByRef s1 As sldworks.Vertex, ByRef s2 As sldworks.Vertex) As Double
905
906		Dim vpoints As Object
907		Dim dPoint() As Double
#	Line 1002 | Line 919 | suite:
919
920		End Function
921
922	<	Public Function Distance(ByRef X1 As Double, ByRef Y1 As Double, ByRef Z1 As Double, ByRef X2 As Double, ByRef Y2 As Double, ByRef Z2 As Double) As Double
922	>	Public Overloads Function Distance(ByRef X1 As Double, ByRef Y1 As Double, ByRef Z1 As Double, ByRef X2 As Double, ByRef Y2 As Double, ByRef Z2 As Double) As Double
923		Return Math.Sqrt((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2 + (Z2 - Z1) ^ 2)
924		End Function
925
926
927	<	Public Function distance(ByRef P1() As Double, ByRef P2() As Double) As Double
927	>	Public Overloads Function distance(ByRef P1() As Double, ByRef P2() As Double) As Double
928		If Not UBound(P1) = 2 And Not UBound(P2) = 2 Then MsgBox("Cette fonction de distance ne marche qu'en 3D pour l'instant")
929		Return Math.Sqrt((P1(0) - P2(0)) ^ 2 + (P1(1) - P2(1)) ^ 2 + (P1(2) - P2(2)) ^ 2)
930		End Function
931
932
933	<	Public Function distance(ByRef P1() As Double, ByRef s2 As SldWorks.Vertex) As Double
933	>	Public Overloads Function distance(ByRef P1() As Double, ByRef s2 As sldworks.Vertex) As Double
934
935		Dim vpoints As Object
936		Dim dPoint() As Double
#	Line 1031 | Line 948 | suite:
948
949		End Function
950
951	<	Public Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetCoque) As Double
951	>	Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetCoque) As Double
952		Return Distance(s1.swSommet, s2.swSommet)
953		End Function
954
955	<	Public Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetVolume) As Double
955	>	Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetVolume) As Double
956		Return Distance(s1.swSommet, s2.swSommet)
957		End Function
958
959	+	''' <summary>
960	+	''' Distance entre un point d'esquisse et un sommet
961	+	''' </summary>
962	+	''' <param name="swPoint"></param>
963	+	''' <param name="SwSommet"></param>
964	+	''' <returns></returns>
965	+	''' <remarks></remarks>
966	+	Public Overloads Function Distance(ByRef swPoint As sldworks.SketchPoint, ByRef SwSommet As sldworks.Vertex) As Double
967	+	Dim P(2) As Double
968	+	P(0) = swPoint.X : P(1) = swPoint.Y : P(2) = swPoint.Z
969	+	P = Commun.TransfertModelSketch(swPoint.GetSketch, P)
970	+	Dim esom As New SuperSommet(SwSommet, True)
971	+	Return Math.Sqrt((esom.X - P(0)) ^ 2 + (esom.Y - P(1)) ^ 2 + (esom.Z - P(2)) ^ 2)
972	+
973	+	End Function
974	+
975
976	<	Public Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetPoutre) As Double
976	>	Public Overloads Function Distance(ByRef s1 As SlySommetPoutre, ByRef s2 As SlySommetPoutre) As Double
977		Return Distance(s1.swSommet, s2.swSommet)
978		End Function
979
#	Line 1156 | Line 1089 | suite:
1089		End Sub
1090
1091		' procédure de débuggage qui place un point là où on le demande. (avec un sketch3D)
1092	<	Public Sub MettreUnPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Selection As Boolean = False)
1093	<	Dim point As SldWorks.SketchPoint
1092	>	Public Overloads Sub MettreUnPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Selection As Boolean = False)
1093	>	Dim point As sldworks.SketchPoint
1094		swModel.Insert3DSketch2(True)
1095		point = swModel.CreatePoint2(x, y, z)
1096		swModel.Insert3DSketch2(False)
#	Line 1167 | Line 1100 | suite:
1100		End If
1101		End Sub
1102
1103	<	Public Function MettreUnPoint(ByRef Plan As SldWorks.RefPlane, ByRef x As Double, ByRef y As Double, ByRef z As Double) As SldWorks.SketchPoint
1104	<	Dim swent As SldWorks.Entity
1103	>	Public Overloads Function MettreUnPoint(ByRef Plan As sldworks.RefPlane, ByRef x As Double, ByRef y As Double, ByRef z As Double) As sldworks.SketchPoint
1104	>	Dim swent As sldworks.Entity
1105		Dim p(2) As Double
1106		p(0) = x
1107		p(1) = y
#	Line 1182 | Line 1115 | suite:
1115		swModel.EditRebuild3()
1116		End Function
1117
1118	<	Public Function MettreUneLigne(ByRef Plan As SldWorks.RefPlane, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As SldWorks.SketchSegment
1119	<	Dim swent As SldWorks.Entity
1118	>	Public Overloads Function MettreUneLigne(ByRef Plan As sldworks.RefPlane, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
1119	>	Dim swent As sldworks.Entity
1120		Dim p(2) As Double, p2(2) As Double
1121		p(0) = x1 : p(1) = y1 : p(2) = z1
1122		p2(0) = x2 : p2(1) = y2 : p2(2) = z2
#	Line 1197 | Line 1130 | suite:
1130		swModel.EditRebuild3()
1131		End Function
1132
1133	<	Public Function MettreUneLigne(ByRef face As SldWorks.Face2, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As SldWorks.SketchSegment
1134	<	Dim swent As SldWorks.Entity
1133	>	Public Overloads Function MettreUneLigne(ByRef face As sldworks.Face2, ByRef x1 As Double, ByRef y1 As Double, ByRef z1 As Double, ByRef x2 As Double, ByRef y2 As Double, ByRef z2 As Double) As sldworks.SketchSegment
1134	>	Dim swent As sldworks.Entity
1135		Dim p(2) As Double, p2(2) As Double
1136		p(0) = x1 : p(1) = y1 : p(2) = z1
1137		p2(0) = x2 : p2(1) = y2 : p2(2) = z2
#	Line 1212 | Line 1145 | suite:
1145		swModel.EditRebuild3()
1146		End Function
1147
1148	<
1148	>	''' <summary>
1149	>	''' Créé une ligne dans un sketch selon ses 2 points d'extrémités
1150	>	''' </summary>
1151	>	''' <param name="P"></param>
1152	>	''' <param name="P2"></param>
1153	>	''' <remarks></remarks>
1154	>	Public Overloads Sub MettreUneLigne(ByRef P() As Double, ByRef P2() As Double)
1155	>	swModel.Insert3DSketch2(False)
1156	>	swModel.CreateLine2(P(0), P(1), P(2), P2(0), P2(1), P2(2))
1157	>	swModel.Insert3DSketch2(False)
1158	>	swModel.EditRebuild3()
1159	>	End Sub
1160
1161
1162
1163
1164		Public Sub EffacerAnnoEtCoord()
1165	<	Dim anno As SldWorks.Annotation
1166	<	Dim ent As SldWorks.Entity
1167	<	Dim prochainAnno As SldWorks.Annotation
1165	>	Dim anno As sldworks.Annotation
1166	>	Dim ent As sldworks.Entity
1167	>	Dim prochainAnno As sldworks.Annotation
1168
1169		anno = swModel.GetFirstAnnotation2
1170
#	Line 1233 | Line 1177 | suite:
1177
1178
1179		' parcours des features pour éliminer les Points3
1180	<	Dim feat As SldWorks.Feature
1181	<	Dim nextfeat As SldWorks.Feature
1180	>	Dim feat As sldworks.Feature
1181	>	Dim nextfeat As sldworks.Feature
1182		feat = swPart.FirstFeature
1183
1184		Do While Not feat Is Nothing
#	Line 1252 | Line 1196 | suite:
1196
1197		End Sub
1198
1199	<	Sub MettreAttributPourFaceInterne(ByRef swFaceInterne As SldWorks.Face2)
1199	>	Sub MettreAttributPourFaceInterne(ByRef swFaceInterne As sldworks.Face2)
1200		' Sub qui place l'attribut de faceinterne sur une face
1201	<	Dim attr As SldWorks.Attribute
1202	<	Dim swent As SldWorks.Entity
1201	>	Dim attr As sldworks.Attribute
1202	>	Dim swent As sldworks.Entity
1203		Static no As Integer = 1
1204		Dim nom2 As String
1205
#	Line 1274 | Line 1218 | suite:
1218		no += 1
1219		End Sub
1220
1221	<	Private Function Ignorer(ByRef swArete As SldWorks.Edge) As Boolean
1222	<	Dim attr As SldWorks.Attribute
1223	<	Dim SwEnt As SldWorks.Entity
1224	<	Dim p As SldWorks.Parameter
1221	>	Private Function Ignorer(ByRef swArete As sldworks.Edge) As Boolean
1222	>	Dim attr As sldworks.Attribute
1223	>	Dim SwEnt As sldworks.Entity
1224	>	Dim p As sldworks.Parameter
1225		SwEnt = swArete
1226		attr = SwEnt.FindAttribute(DefAttrRCP1, 0)
1227		If attr Is Nothing Then Return False
#	Line 1285 | Line 1229 | suite:
1229		If p.GetDoubleValue = -9 Then Return True Else Return False
1230		End Function
1231
1232	<	Public Sub GetMidPointSegment(ByVal seg As SldWorks.SketchSegment, ByRef x As Double, ByRef y As Double, ByRef z As Double)
1233	<	Dim curve As SldWorks.Curve
1232	>	Public Sub GetMidPointSegment(ByVal seg As sldworks.SketchSegment, ByRef x As Double, ByRef y As Double, ByRef z As Double)
1233	>	Dim curve As sldworks.Curve
1234		Dim start As Double
1235		Dim pend As Double
1236		Dim isClosed As Boolean
#	Line 1309 | Line 1253 | suite:
1253		End Sub
1254
1255		Public Sub SelectFaceByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
1256	<	Dim swent As SldWorks.Entity
1256	>	Dim swent As sldworks.Entity
1257		swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelFACES)
1258		swent.Select4(append, Nothing)
1259		End Sub
1260
1261		Public Sub SelectAreteByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
1262	<	Dim swent As SldWorks.Entity
1262	>	Dim swent As sldworks.Entity
1263		swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelEDGES)
1264		swent.Select4(append, Nothing)
1265		End Sub
1266
1267		Public Sub SelectSommetByName(ByVal Nom As String, Optional ByVal append As Boolean = False)
1268	<	Dim swent As SldWorks.Entity
1268	>	Dim swent As sldworks.Entity
1269		swent = swPart.GetEntityByName(Nom, swconst.swSelectType_e.swSelVERTICES)
1270		swent.Select4(append, Nothing)
1271		End Sub
1272
1273	<	Public Function DessineCourbe(ByRef curve As SldWorks.Curve) As SldWorks.SketchSegment
1274	<	Dim modeler As SldWorks.Modeler
1273	>	Public Function DessineCourbe(ByRef curve As sldworks.Curve) As sldworks.SketchSegment
1274	>	Dim modeler As sldworks.Modeler
1275		Dim vp1 As Object : Dim P1() As Double
1276		Dim vp2 As Object : Dim P2() As Double
1277		Dim dir(2) As Double
1278	<	Dim sketchseg As SldWorks.SketchSegment = Nothing
1278	>	Dim sketchseg As sldworks.SketchSegment = Nothing
1279		Dim i As Integer
1280		Dim Tmax As Double, Tmin As Double
1281		Dim ajout As Double
#	Line 1373 | Line 1317 | suite:
1317		Return Nothing
1318		End Function
1319
1320	<	Function AngleEntre2Faces(ByRef swface1 As SldWorks.Face2, ByRef swface2 As SldWorks.Face2, ByRef P() As Double) As Double
1320	>	Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef P() As Double) As Double
1321		' function qui trouve l'angle entre 2 faces au point spécifié...
1322		Return AngleEntre2Faces(swface1, swface2, P(0), P(1), P(2))
1323		End Function
1324
1325	<	Function AngleEntre2Faces(ByRef swface1 As SldWorks.Face2, ByRef swface2 As SldWorks.Face2, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
1325	>	Function AngleEntre2Faces(ByRef swface1 As sldworks.Face2, ByRef swface2 As sldworks.Face2, ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
1326		' function qui trouve l'angle entre 2 faces au point spécifié...
1327	<	Dim swSurf As SldWorks.Surface
1327	>	Dim swSurf As sldworks.Surface
1328		Dim retval As Object
1329		Dim Normale1(2) As Double
1330		Dim Normale2(2) As Double
#	Line 1403 | Line 1347 | suite:
1347		Public Sub Test()
1348		' se déclenche quand on apuie sur le bouton 4
1349
1350	<	Dim lst As New Collections.ObjectModel.Collection(Of SldWorks.Vertex)
1350	>	Dim lst As New Collections.ObjectModel.Collection(Of sldworks.Vertex)
1351
1352		Intersections.RegisterAttribut()
1353
1354		swModel.EditRebuild3()
1355		' on fait le tour des features pour avoir les poutres et les coques
1356	<	Dim feat As SldWorks.Feature
1356	>	Dim feat As sldworks.Feature
1357		Dim vSupprime As Object
1358		Dim bSupprime As Boolean
1359	<	Dim attr As SldWorks.Attribute
1360	<	Dim swArete As SldWorks.Edge
1361	<	Dim swSommet1 As SldWorks.Vertex
1362	<	Dim swSommet2 As SldWorks.Vertex
1359	>	Dim attr As sldworks.Attribute
1360	>	Dim swArete As sldworks.Edge
1361	>	Dim swSommet1 As sldworks.Vertex
1362	>	Dim swSommet2 As sldworks.Vertex
1363
1364		feat = swPart.FirstFeature
1365
#	Line 1428 | Line 1372 | suite:
1372		Select Case feat.GetTypeName
1373		Case "CompositeCurve", "3DSplineCurve", "Helix"  'le feature est une courbe libre
1374
1375	<	Dim refCourbe As SldWorks.ReferenceCurve
1375	>	Dim refCourbe As sldworks.ReferenceCurve
1376		refCourbe = feat.GetSpecificFeature2
1377		swArete = refCourbe.GetFirstSegment
1378		Do While Not swArete Is Nothing
#	Line 1459 | Line 1403 | suite:
1403		Loop
1404
1405
1406	<	Dim swEnt As SldWorks.Entity
1407	<	For Each s As SldWorks.Vertex In lst
1406	>	Dim swEnt As sldworks.Entity
1407	>	For Each s As sldworks.Vertex In lst
1408		swEnt = s
1409		attr = swEnt.FindAttribute(DefAttrDoublon, 0)
1410		If Not attr Is Nothing Then
1411	<	Dim p As SldWorks.Parameter = attr.GetParameter("Maitre")
1411	>	Dim p As sldworks.Parameter = attr.GetParameter("Maitre")
1412		MsgBox(p.GetStringValue)
1413		End If
1414		Next
1415
1416	+	End Sub
1417	+
1418	+
1419	+	''' <summary>
1420	+	''' Sub qui dessine avec des corps temporaires le sens des arètes et la normale des faces.
1421	+	''' </summary>
1422	+	''' <remarks></remarks>
1423	+	Public Sub DessinerSensAretesEtNormaleFace()
1424	+
1425	+	Try
1426	+	Dim lst_fleches_Face As New Collections.Generic.List(Of sldworks.Body2)
1427	+	Dim lst_fleches_Arete As New Collections.Generic.List(Of sldworks.Body2)
1428	+	Dim lst_fleches_CoArete As New Collections.Generic.List(Of sldworks.Body2)
1429	+	Dim selmgr As sldworks.SelectionMgr = swModel.SelectionManager
1430	+	Dim ext As sldworks.ModelDocExtension = swModel.Extension
1431	+	Dim normale(2) As Double
1432	+
1433	+	Dim swMprop As sldworks.MassProperty = swModel.Extension.CreateMassProperty
1434	+	Dim volume As Double = swMprop.Volume
1435	+	Dim surface As Double = swMprop.SurfaceArea
1436	+	Dim Grosseur As Double = (volume / surface) / 4
1437	+	Dim centreX, centreY, centreZ As Double
1438	+	Dim Dx, Dy, Dz As Double
1439	+	Dim D(2) As Double
1440	+	Dim bod As sldworks.Body2
1441	+
1442	+	' pour dessiner les normales
1443	+	Dim swFace As sldworks.Face2
1444	+	Dim swEnt As sldworks.Entity
1445	+
1446	+	For ff As Integer = 1 To selmgr.GetSelectedObjectCount
1447	+	If selmgr.GetSelectedObjectType3(ff, -1) = swconst.swSelectType_e.swSelFACES Then
1448	+	swEnt = selmgr.GetSelectedObject6(ff, -1)
1449	+	swFace = swEnt
1450	+	Else
1451	+	Continue For
1452	+	End If
1453	+
1454	+	Dim F As New SuperFace(swFace, True)
1455	+	Dim Umin As Double, Umax As Double, Vmin As Double, Vmax As Double, U As Double, V As Double
1456	+	Dim i As Integer, j As Integer, Uinc As Double, Vinc As Double
1457	+
1458	+
1459	+	F.UVMinMax(Umin, Umax, Vmin, Vmax)
1460	+	V = Vmin
1461	+	U = Umin
1462	+	Uinc = (Umax - Umin) / 5
1463	+	Vinc = (Vmax - Vmin) / 5
1464	+
1465	+	For i = 1 To 4
1466	+	U += Uinc
1467	+	V = Vmin
1468	+	For j = 1 To 4
1469	+	V += Vinc
1470	+
1471	+	If F.Evaluer(U, V, centreX, centreY, centreZ) Then
1472	+	normale = F.Normale(centreX, centreY, centreZ)
1473	+	Dx = normale(0) : Dy = normale(1) : Dz = normale(2)
1474	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, Dx, Dy, Dz, 255, 0, 0, Grosseur)
1475	+	lst_fleches_Face.Add(bod)
1476	+	End If
1477	+	Next j
1478	+	Next i
1479	+
1480	+
1481	+
1482	+	' mémoriser les points des aretes
1483	+	'Dim vEdge As Object = swFace.GetEdges
1484	+	Dim loope As sldworks.Loop2 = swFace.GetFirstLoop
1485	+
1486	+	While loope IsNot Nothing
1487	+
1488	+	Dim CoArete As sldworks.CoEdge = loope.GetFirstCoEdge
1489	+
1490	+	For coa As Integer = 0 To loope.GetEdgeCount - 1
1491	+
1492	+	Dim swArete As sldworks.Edge
1493	+	swArete = CoArete.GetEdge
1494	+	'For Each swArete As sldworks.Edge In vEdge
1495	+	Dim a As New SuperArete(swArete, True)
1496	+	Dim Tmin As Double, Tmax As Double
1497	+	Dim incT As Double, T As Double
1498	+
1499	+	Tmax = a.GetTMax()
1500	+	Tmin = a.GetTMin
1501	+	incT = (Tmax - Tmin) / 5
1502	+
1503	+	T = Tmin
1504	+	a.Evaluer(T, centreX, centreY, centreZ)
1505	+	D = a.GetTangence(T)
1506	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
1507	+	lst_fleches_Arete.Add(bod)
1508	+
1509	+	T = Tmin + 1 * incT
1510	+	a.Evaluer(T, centreX, centreY, centreZ)
1511	+	D = a.GetTangence(T)
1512	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
1513	+	lst_fleches_Arete.Add(bod)
1514	+
1515	+	T = Tmin + 2 * incT
1516	+	a.Evaluer(T, centreX, centreY, centreZ)
1517	+	D = a.GetTangence(T)
1518	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 2)
1519	+	lst_fleches_Arete.Add(bod)
1520	+
1521	+
1522	+	T = Tmin + 3 * incT
1523	+	a.Evaluer(T, centreX, centreY, centreZ)
1524	+	D = a.GetTangence(T)
1525	+	If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
1526	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
1527	+	lst_fleches_CoArete.Add(bod)
1528	+
1529	+	T = Tmin + 4 * incT
1530	+	a.Evaluer(T, centreX, centreY, centreZ)
1531	+	D = a.GetTangence(T)
1532	+	If Not CoArete.GetSense() Then D = Outils_Math.InverserVecteur(D)
1533	+	bod = Commun.FlecheTemporaire(centreX, centreY, centreZ, D(0), D(1), D(2), 125, 0, 0, Grosseur / 4)
1534	+	lst_fleches_CoArete.Add(bod)
1535	+
1536	+	CoArete = CoArete.GetNext
1537	+	Next coa ' coarete
1538	+	loope = loope.GetNext
1539	+	End While ' loope
1540	+
1541	+	Next ff
1542	+
1543	+
1544	+	For Each body As sldworks.Body2 In lst_fleches_Face
1545	+	body.Display3(swPart, 1, 0)
1546	+	Next
1547	+
1548	+	For Each body As sldworks.Body2 In lst_fleches_Arete
1549	+	body.Display3(swPart, RGB(255, 0, 0), 0)
1550	+	Next
1551	+
1552	+	For Each body As sldworks.Body2 In lst_fleches_CoArete
1553	+	body.Display3(swPart, RGB(200, 0, 200), 0)
1554	+	Next
1555	+
1556	+	Catch ex As Exception
1557	+	swApp.SendMsgToUser2("Ça n'a pas marché!", swconst.swMessageBoxIcon_e.swMbInformation, swconst.swMessageBoxBtn_e.swMbOk)
1558	+	End Try
1559
1560
1561
1562		End Sub
1563
1564
1565	+	''' <summary>
1566	+	''' Dessine une flèche temporaire (temp. Body)
1567	+	''' </summary>
1568	+	''' <param name="CentreX"></param>
1569	+	''' <param name="centreY"></param>
1570	+	''' <param name="centreZ"></param>
1571	+	''' <param name="Dx"></param>
1572	+	''' <param name="Dy"></param>
1573	+	''' <param name="Dz"></param>
1574	+	''' <param name="Rouge"></param>
1575	+	''' <param name="Vert"></param>
1576	+	''' <param name="Bleu"></param>
1577	+	''' <param name="Grosseur"></param>
1578	+	''' <returns>Le Body2 représentant la flèche</returns>
1579	+	''' <remarks></remarks>
1580	+	Public Function FlecheTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, Optional ByVal Rouge As Integer = 255, Optional ByVal Vert As Integer = 0, Optional ByVal Bleu As Integer = 0, Optional ByVal Longueur As Double = 1) As sldworks.Body2
1581	+	Dim P(2) As Double
1582	+	Dim Bod1, bod2 As sldworks.Body2
1583	+	Dim vBod As Object
1584	+	Dim errcode As Integer
1585	+
1586	+	Bod1 = CylindreTemporaire(CentreX, centreY, centreZ, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))
1587	+
1588	+	P(0) = Dx : P(1) = Dy : P(2) = Dz
1589	+	P = Outils_Math.unitaire(P)
1590	+	bod2 = ConeTemporaire(CentreX + P(0) * Longueur, centreY + P(1) * Longueur, centreZ + P(2) * Longueur, Dx, Dy, Dz, Longueur, RGB(Rouge, Vert, Bleu))
1591	+	vBod = Bod1.Operations2(swconst.swBodyOperationType_e.SWBODYADD, bod2, errcode)
1592	+	Return vBod(0)
1593	+
1594	+	End Function
1595	+
1596	+
1597	+
1598	+	''' <summary>
1599	+	''' Dessine un cylindre avec un temporary body
1600	+	''' </summary>
1601	+	''' <param name="CentreX"></param>
1602	+	''' <param name="centreY"></param>
1603	+	''' <param name="centreZ"></param>
1604	+	''' <param name="Dx"></param>
1605	+	''' <param name="Dy"></param>
1606	+	''' <param name="Dz"></param>
1607	+	''' <param name="longueur"></param>
1608	+	''' <param name="couleur"></param>
1609	+	''' <remarks></remarks>
1610	+	Public Function CylindreTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
1611	+	Dim View As sldworks.ModelView = swModel.ActiveView()
1612	+	Dim swModeler As sldworks.Modeler = swApp.GetModeler
1613	+	Dim NewBod As sldworks.Body2
1614	+	Dim liste(7) As Double, vListe As Object
1615	+
1616	+	liste(0) = CentreX  ' les 3 points de centre
1617	+	liste(1) = centreY
1618	+	liste(2) = centreZ
1619	+	liste(3) = Dx    ' l'axe du cone
1620	+	liste(4) = Dy
1621	+	liste(5) = Dz
1622	+	liste(6) = longueur / 6 ' radius, le 1/6 de la longueur
1623	+	liste(7) = longueur  ' hauteur
1624	+
1625	+	vListe = liste
1626	+	NewBod = swModeler.CreateBodyFromCyl(vListe)
1627	+	NewBod.Display2(swPart, couleur, 0)
1628	+	Return NewBod
1629	+	End Function
1630	+
1631	+	''' <summary>
1632	+	''' Dessine un cone avec un temporary body
1633	+	''' </summary>
1634	+	''' <param name="CentreX"></param>
1635	+	''' <param name="centreY"></param>
1636	+	''' <param name="centreZ"></param>
1637	+	''' <param name="Dx"></param>
1638	+	''' <param name="Dy"></param>
1639	+	''' <param name="Dz"></param>
1640	+	''' <param name="longueur"></param>
1641	+	''' <param name="couleur"></param>
1642	+	''' <remarks></remarks>
1643	+	Public Function ConeTemporaire(ByVal CentreX As Double, ByVal centreY As Double, ByVal centreZ As Double, ByVal Dx As Double, ByVal Dy As Double, ByVal Dz As Double, ByVal longueur As Double, ByVal couleur As Integer) As sldworks.Body2
1644	+	Dim View As sldworks.ModelView = swModel.ActiveView()
1645	+	Dim swModeler As sldworks.Modeler = swApp.GetModeler
1646	+	Dim liste(8) As Double, vListe As Object
1647	+	Dim NewBod As sldworks.Body2
1648	+
1649	+	liste(0) = CentreX  ' les 3 points de centre
1650	+	liste(1) = centreY
1651	+	liste(2) = centreZ
1652	+	liste(3) = Dx    ' l'axe du cone
1653	+	liste(4) = Dy
1654	+	liste(5) = Dz
1655	+	liste(6) = longueur / 2 ' base radius
1656	+	liste(7) = 0 'top radius
1657	+	liste(8) = longueur ' hauteur
1658	+	vListe = liste
1659	+	NewBod = swModeler.CreateBodyFromCone(vListe)
1660	+	NewBod.Display2(swPart, couleur, 0)
1661	+	Return NewBod
1662	+	End Function
1663	+
1664	+
1665	+
1666	+	''' <summary>
1667	+	''' Créer une annotation qui pointe sur les coordonnées spécifiées
1668	+	''' </summary>
1669	+	''' <param name="x">La flèche de l'annotation pointera dessu.</param>
1670	+	''' <param name="y"></param>
1671	+	''' <param name="z"></param>
1672	+	''' <param name="Texte">Le texte à y écrire</param>
1673	+	''' <remarks></remarks>
1674	+	Public Sub CreerAnnotation(ByVal x As Double, ByVal y As Double, ByVal z As Double, Optional ByVal Texte As String = " NT ")
1675	+	Commun.MettreUnPoint(x, y, z, True)
1676	+	Dim swNote As sldworks.Note
1677	+	swNote = swModel.InsertNote(Texte)
1678	+	End Sub
1679	+
1680	+
1681	+
1682	+
1683	+
1684	+	Public Class Point
1685	+	Public X As Double
1686	+	Public Y As Double
1687	+	Public Z As Double
1688	+
1689	+	''' <summary>
1690	+	''' Attention de ne pas oublier de fixer les valeurs de x,y et z plus tard.
1691	+	''' </summary>
1692	+	''' <remarks></remarks>
1693	+	Public Sub New()
1694	+
1695	+	End Sub
1696	+
1697	+	Public Sub New(ByVal x As Double, ByVal y As Double, ByVal z As Double)
1698	+	Me.X = x : Me.Y = y : Me.Z = z
1699	+	End Sub
1700	+
1701	+	Public Shared Operator =(ByVal P1 As Point, ByVal P2 As Point) As Boolean
1702	+	If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return True Else Return False
1703	+	End Operator
1704	+
1705	+	Public Shared Operator <>(ByVal P1 As Point, ByVal P2 As Point) As Boolean
1706	+	If Math.Abs(P1.X - P2.X) < Epsilon AndAlso Math.Abs(P1.Y - P2.Y) < Epsilon AndAlso Math.Abs(P1.Z - P2.Z) < Epsilon Then Return False Else Return True
1707	+	End Operator
1708	+
1709	+	Public Shared Narrowing Operator CType(ByVal P As Point) As String
1710	+	Return (Replace(CStr(P.X), ",", ".") & " " & Replace(CStr(P.Y), ",", ".") & " " & Replace(CStr(P.Z), ",", "."))
1711	+	End Operator
1712	+
1713	+
1714	+	End Class
1715	+
1716
1717
1718

Diff Legend

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