ViewVC Help

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

root/REPOS_ERICCA/magicsld/SuperArete.vb

Comparing magicsld/SuperArete.vb (file contents):
Revision 40 by bournival, Mon Aug 20 21:30:28 2007 UTC vs.
Revision 130 by bournival, Wed Jul 30 21:26:03 2008 UTC

#	Line 1 | Line 1
1	+	Imports SolidWorks.Interop
2	+	Imports SolidWorks.Interop.swconst
3	+	Imports SolidWorks.Interop.swpublished
4	+
5		Public Class SuperArete
6		Inherits SuperEntite
7		Public swArete As SldWorks.Edge
#	Line 16 | Line 20 | Public Class SuperArete
20		Public Sub New(ByRef swArete As SldWorks.Edge, ByRef encapsulateur As Boolean)
21		Me.swArete = swArete
22		Me.swCourbe = swArete.GetCurve
23	+
24	+
25		End Sub
26
27	<	Public Sub New(ByRef arete As SldWorks.Edge, Optional ByVal tip As integer = 0)
27	>
28	>
29	>	Public Sub New(ByRef arete As SldWorks.Edge, Optional ByVal tip As Integer = 0)
30		Me.swArete = arete
31		Me.swCourbe = swArete.GetCurve
32		Select Case tip
#	Line 45 | Line 53 | Public Class SuperArete
53		Try
54		retval = swPart.SetEntityName(ent, nom)
55		Catch
48	–	Debug.Write("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) ' MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom)
49	–	End Try
56
57	<	Dim i As Integer
58	<	If retval = False Then
59	<	Do Until retval = True
60	<	i += 1
61	<	retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
62	<	Loop
63	<	Me.nom = nom & Chr(96 + i)
64	<	Debug.Write("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom) ' MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom, MsgBoxStyle.Critical, "Problème dans le setID de l'arrète")
65	<	End If
57	>
58	>	Dim i As Integer
59	>	If retval = False Then
60	>	Do Until retval = True
61	>	i += 1
62	>	retval = swPart.SetEntityName(ent, nom & Chr(96 + i))
63	>	Loop
64	>	Me.nom = nom & Chr(96 + i)
65	>	'MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom) ' MsgBox("Impossibilité d'écrire le nom de l'entité... il y a déjà un nom." & Chr(13) & nom, MsgBoxStyle.Critical, "Problème dans le setID de l'arrète")
66	>	End If
67	>	MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom) ' MsgBox("Le prog ne veut pas mettre le nom sur une entité.." & vbCr & "Le nom devrait être: " & nom)
68	>	End Try
69		End Sub
70
71		Shared Sub reinitialiser()
#	Line 162 | Line 171 | Public Class SuperArete
171		'''  Renvoie les coordonnées du point milieu
172		''' </summary>
173		''' <returns></returns>
174	<	''' <remarks></remarks>
175	<	Public Function GetPointMilieu() As Double()
174	>	''' <remarks>Attention: Ce sont les coordonnées du point à T milieu, ce qui n'est pas nécessairement le milieu de l'arète dans le cas de b-spline </remarks>
175	>	Public Function GetPointMilieu(Optional ByVal Reverse As Boolean = False) As Double()
176		Dim T As Double
177		Dim xyz(2) As Double
178	<	T = Me.GetTMilieu
178	>	T = Me.GetTMilieu(Reverse)
179		Me.Evaluer(T, xyz)
180		Return xyz
181		End Function
#	Line 174 | Line 183 | Public Class SuperArete
183		''' <summary>
184		'''  Renvoie les coordonnées du point milieu
185		''' </summary>
186	<	''' <returns>Faux si le sommet n'esiste pas</returns>
186	>	''' <returns>Faux si le sommet n'existe pas</returns>
187		''' <remarks></remarks>
188	<	Public Function GetPointMilieu(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
188	>	Public Function GetPointMilieu(ByRef x As Double, ByRef y As Double, ByRef z As Double, Optional ByVal Reverse As Boolean = False) As Boolean
189		Dim T As Double
190	<	T = Me.GetTMilieu
190	>	T = Me.GetTMilieu(Reverse)
191		Me.Evaluer(T, x, y, z)
192		Return True
193		End Function
#	Line 192 | Line 201 | Public Class SuperArete
201		''' <returns>Vrai si la courbe est une ligne</returns>
202		''' <remarks></remarks>
203		Public Function IsLine() As Boolean
204	+
205	+	Dim ev As Object = Me.swArete.Evaluate(0.2)
206	+	Dim cr As sldworks.Curve = Me.swArete.GetCurve
207	+
208		Try
209	<	Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve
210	<	Return swCourbe.IsLine()
209	>	Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve
210	>	Select Case swCourbe.Identity()
211	>
212	>	Case swconst.swCurveTypes_e.LINE_TYPE
213	>	Return True
214	>
215	>	Case Else
216	>	Return False
217	>	End Select
218	>
219		Catch
220	<	Dim fault As SldWorks.FaultEntity = Me.swArete.Check
221	<	Debug.WriteLine("N'arrive pas à déterminer si la courbe est une ligne" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom)
222	<	Return True
220	>	' on a un drole de type de courbe... on ne peut dire si c'est une ligne ou autre...
221	>	Try
222	>	Dim swCourbe2 As sldworks.Curve = swCourbe.GetBaseCurve
223	>	Select Case swCourbe2.Identity()
224	>
225	>	Case swconst.swCurveTypes_e.LINE_TYPE
226	>	Return True
227	>
228	>	Case Else
229	>	Return False
230	>	End Select
231	>	Catch ex As Exception
232	>
233	>	End Try
234	>
235	>
236	>	Return False
237		End Try
238
239		End Function
240
241	+
242	+	''' <summary>
243	+	''' Retourne vrai si la courbe est fermée
244	+	''' </summary>
245	+	''' <value></value>
246	+	''' <returns></returns>
247	+	''' <remarks></remarks>
248	+	Public ReadOnly Property IsClosed() As Boolean
249	+	Get
250	+	If Me.swArete.GetStartVertex Is Nothing Then Return False Else Return True
251	+	End Get
252	+	End Property
253	+
254		''' <summary>
255		''' Détermine si la courbe est un cercle
256		''' </summary>
257		''' <returns>Vrai si la courbe est un cercle</returns>
258		''' <remarks></remarks>
259		Public Function IsCircle() As Boolean
260	+
261		Try
262
263	<	Dim swCourbe As SldWorks.Curve = Me.swArete.GetCurve
215	<	If swCourbe.IsLine Then Return False
263	>	If Me.swCourbe.IsLine Then Return False
264		Return Me.swCourbe.IsCircle
265		Catch ex As Exception
266	<	Dim fault As SldWorks.FaultEntity = Me.swArete.Check
266	>	Dim fault As sldworks.FaultEntity = Me.swArete.Check
267		Debug.WriteLine("N'arrive pas à déterminer si la courbe est un cercle" & vbCr & "FaultEntity.Count = " & IIf(fault Is Nothing, "0", fault.Count) & vbCr & Me.nom)
268	+
269	+	Try
270	+	If swCourbe.Identity() = swconst.swCurveTypes_e.CIRCLE_TYPE Then Return True Else Return False
271	+
272	+	Catch
273	+	Debug.Print("Même merde que pour la ligne, le lien entre la courbe et le pointeur se perd par magie!")
274	+	End Try
275	+
276		Return False
277		End Try
278
#	Line 278 | Line 334 | Public Class SuperArete
334		''' <param name="Bleu">Le ton de bleu, entre 0 et 1</param>
335		''' <remarks></remarks>
336		Public Sub Colorer(Optional ByVal Largeur As Integer = 2, Optional ByRef Rouge As Double = 1, Optional ByRef Vert As Double = 0, Optional ByRef Bleu As Double = 0)
337	<	SwArete.Display(Largeur, Rouge, Vert, Bleu, True)
337	>	swArete.Display(Largeur, Rouge, Vert, Bleu, True)
338		End Sub
339
340
341		''' <summary>
342	<	''' Sub qui met ou Update les paramètres des doublons des arètes
342	>	''' Sub qui met ou Update les paramètres des doublons des arètes.  Une entité avec un attribut de doublon est ignoré par MAGiC
343		''' </summary>
344		''' <param name="Numero">Le numéro que l'on veut attribuer</param>
345		''' <param name="Maitre">Si ce,st un maitre on met true</param>
#	Line 308 | Line 364 | Public Class SuperArete
364		Do While attr Is Nothing
365		nom = "DoublonA_" & Format(Numero, "000")
366		If Maitre Then nom &= "Maitre" Else nom &= "Esclave"
367	<	attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, SwArete, nom, 0, 2) ' 0 = swThisconfig
367	>	attr = Intersections.DefAttrDoublon.CreateInstance5(swModel, swArete, nom, 0, 2) ' 0 = swThisconfig
368		If attr Is Nothing Then Numero += 1
369		Loop
370
371		ParamMaitre = attr.GetParameter("Maitre")
372	<	paramsens = attr.GetParameter("Sens")
372	>	paramSens = attr.GetParameter("Sens")
373		If NomMaitre = Nothing Then
374		NomMaitre = "Inconnu"
375
#	Line 332 | Line 388 | Public Class SuperArete
388		Dim SlySommetTest As SlySommetVolume
389
390		For Each SlySommetTest In Commun.lst_SommetVolume
391	<	If Not premier AndAlso Distance(esom1.GetSommet, SlySommetTest.swSommet) < Epsilon Then ' on vient de trouver le sommet du volume
391	>	If Not premier AndAlso Distance(esom1.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then ' on vient de trouver le sommet du volume
392		esom1.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet)
393		premier = True
394	<	ElseIf Distance(esom2.GetSommet, SlySommetTest.swSommet) < Epsilon Then
394	>	ElseIf Distance(esom2.GetSommet, SlySommetTest.swSommet) < (10000 * Epsilon) Then
395		esom2.MettreAttributDoublonSommet(SlySommetTest.nom, SlySommetTest.swSommet)
396		second = True
397		End If
#	Line 347 | Line 403 | Public Class SuperArete
403		' trouver si le sens est le même, mettre 1 si oui, et -1 si non.
404		' on met 1 si les 2 startvertex sont au même endroit, -1 si ce n'est pas le cas
405
406	<	Dim a As SlyAreteVol = Nothing
406	>	Dim a As SuperArete = Nothing
407	>	Dim trouve As Boolean = False
408		Dim som1 As SldWorks.Vertex, som2 As SldWorks.Vertex
409		For Each a In Commun.lst_AreteVolume
410	<	If a.nom = NomMaitre Then Exit For
410	>	If a.nom = NomMaitre Then trouve = True : Exit For
411		Next
412	<	som1 = Me.SwArete.GetStartVertex
412	>
413	>	If Not trouve Then
414	>	For Each a In Commun.lst_AreteCoque
415	>	If a.nom = NomMaitre Then Exit For
416	>	Next
417	>	End If
418	>
419	>
420	>	som1 = Me.swArete.GetStartVertex
421		If som1 IsNot Nothing Then
422		som2 = a.swArete.GetStartVertex
423	+	If som2 Is Nothing Then a.Colorer(4, 0.5, 0, 0.5) : Me.Colorer(4, 1, 0, 1) : MsgBox(a.nom & "  " & Me.nom & "Comparer = " & Me.comparer(a.swArete))
424		If Distance(som1, som2) < Epsilon Then sens = 1 Else sens = -1
425		Else ' wouch!, si on a une courbe fermée, comment on trouve le sens de l'arête maitre comparé à l'arète esclave.
426		' si les 2 arètes sont une par-dessus l'autre, alors je prend le point à t=0 et le T du point équivalent sur l'arète esclave
#	Line 364 | Line 430 | Public Class SuperArete
430		Dim x, y, z, T2, T3 As Double
431		Dim ret As Boolean = Me.Evaluer(0, x, y, z)
432		T2 = a.GetT(x, y, z)
367	–
433		Me.Evaluer(0.1, x, y, z)
434		T3 = a.GetT(x, y, z)
435		If T3 = (T2 + 0.1) Then sens = 1 Else sens = -1
436		End If
437
373	–
374	–
438		End If
439
440		paramSens.SetDoubleValue2(sens, 2, "")
441		ParamMaitre.SetStringValue2(NomMaitre, 2, "")  ' swAllConfiguration = 2
442	<	GererDossiers("Doublons", nom)
442	>	'GererDossiers("Doublons", nom)
443
444	<	'Me.Colorer(2, 1, 1, 0)
444	>	' Me.Colorer(2, 1, 1, 0)
445
446		End Sub
447
#	Line 410 | Line 473 | Public Class SuperArete
473		''' <summary>
474		''' Calcule et retourne le T au milieu de l'arète
475		''' </summary>
476	+	''' <param name="Reverse">Si oui, alors oon retourne le milieu de la courbe inversée.  Le «milieu» n'est pas le même si on a une spline...</param>
477		''' <returns>Le T du milieu</returns>
478		''' <remarks></remarks>
479	<	Public Function GetTMilieu() As Double
480	<	Dim swCourbe As SldWorks.Curve
479	>	Public Function GetTMilieu(Optional ByVal Reverse As Boolean = False) As Double
480	>	Dim swCourbe As sldworks.Curve
481		Dim temp As Object
482		Dim T1 As Double, T2 As Double
483	<	Dim sommet As SldWorks.Vertex
483	>	Dim sommet As sldworks.Vertex
484		Dim point As Object
485
422	–	swCourbe = Me.SwArete.GetCurve
486
487	<	sommet = Me.SwArete.GetStartVertex()
487	>	swCourbe = Me.swArete.GetCurve
488	>	If Reverse Then swCourbe = swCourbe.ReverseCurve()
489	>
490	>	sommet = Me.swArete.GetStartVertex()
491
492		If sommet IsNot Nothing Then
493	<	point = sommet.GetPoint() : temp = SwArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
494	<	sommet = SwArete.GetEndVertex() : point = sommet.GetPoint() : temp = SwArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
493	>	point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
494	>	sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
495		Return (T1 + T2) / 2
496
497		Else
#	Line 450 | Line 516 | Public Class SuperArete
516		Dim retour(1) As Double
517		retval = Me.SwArete.GetParameter(x, y, z)
518		retour = retval
519	<	If Not retour(1) Then MsgBox("GetT n'a pas fonctionné pour cette arête.", MsgBoxStyle.Critical)
519	>	If Not retour(1) Then
520	>	Me.Colorer(2, 1, 0.5, 0) ' : Commun.MettreUnPoint(x, y, z)
521	>	Dim ret As Object = Me.swArete.GetClosestPointOn(x, y, z)
522	>
523	>	Dim obj As Object = Me.swArete.GetClosestPointOn(x, y, z)
524	>	Dim ob() As Double = obj
525	>	retval = Me.swArete.GetParameter(ob(0), ob(1), ob(2))
526	>
527	>	End If
528		Return retour(0)
529		End Function
530
#	Line 461 | Line 535 | Public Class SuperArete
535		''' <remarks></remarks>
536		Public Function GetTMin() As Double
537		Dim vp As Object
538	<	SwArete.GetCurve()
539	<	vp = SwArete.GetCurveParams2()
538	>	swArete.GetCurve()
539	>	vp = swArete.GetCurveParams2()
540		Return vp(6)
541		End Function
542
#	Line 474 | Line 548 | Public Class SuperArete
548		''' <remarks></remarks>
549		Public Function GetTMax() As Double
550		Dim vp As Object
551	<	SwArete.GetCurve()
552	<	vp = SwArete.GetCurveParams2()
551	>	swArete.GetCurve()
552	>	vp = swArete.GetCurveParams2()
553		Return vp(7)
554		End Function
555
#	Line 574 | Line 648 | Public Class SuperArete
648
649		If swArete Is sAreteTest Then Return True
650
577	–	' les conditions suivantes doivent toutes être vrai pour retourner oui..
578	–	' 1 - les types sont les mêmes (lignes, cercles, bsplines...)
579	–	If Not Me.IsLine = sAreteTest.IsLine Then Return False
580	–
651
652
653		' 2 - les 2 points d'extrémités sont identiques.
#	Line 590 | Line 660 | Public Class SuperArete
660		If debut1 Is Nothing And debut2 Is Nothing Then ' peut-être un cercle
661		If Not swModel.ClosestDistance(sAreteTest.swArete, Me.swArete, Nothing, Nothing) < Epsilon Then Return False
662		' bon, on a 2 cercles (ou courbe fermées) qui se touchent à au moins un point...
663	<	Dim courbe1 As SldWorks.Curve = Me.swArete.GetCurve
664	<	Dim courbe2 As SldWorks.Curve = sAreteTest.swArete.GetCurve
663	>	Dim courbe1 As sldworks.Curve = Me.swArete.GetCurve
664	>	Dim courbe2 As sldworks.Curve = sAreteTest.swCourbe
665
666	<	If courbe1.IsCircle AndAlso courbe2.IsCircle Then
666	>	If Me.IsCircle AndAlso sAreteTest.IsCircle Then
667		Dim vparam1 As Object = courbe1.CircleParams()
668		Dim vparam2 As Object = courbe2.CircleParams()
669	<	If Math.Abs(vparam1(0) - vparam2(0)) < Epsilon AndAlso Math.Abs(vparam1(1) - vparam2(1)) < Epsilon AndAlso Math.Abs(vparam1(2) - vparam2(2)) < Epsilon AndAlso Math.Abs(vparam1(6) - vparam2(6)) < Epsilon Then Return True Else Return False ' centreX , y , z , Radius(6)
670	<	ElseIf courbe1.IsEllipse AndAlso courbe1.IsEllipse Then
669	>	If Math.Abs(vparam1(0) - vparam2(0)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(1) - vparam2(1)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(2) - vparam2(2)) < 1000 * Epsilon AndAlso Math.Abs(vparam1(6) - vparam2(6)) < 1000 * Epsilon Then
670	>	Dim tmilieuC As Double = Me.GetTMilieu
671	>	Dim xyzC() As Double = Nothing
672	>	If Not Me.Evaluer(tmilieuC, xyzC) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut....
673	>	Dim vPointC As Object = sAreteTest.swArete.GetClosestPointOn(xyzC(0), xyzC(1), xyzC(2))
674	>	If Distance(xyzC(0), xyzC(1), xyzC(2), vPointC(0), vPointC(1), vPointC(2)) < 0.000001 Then Return True Else Return False
675	>	Else
676	>	Return False
677	>	End If
678	>
679	>	ElseIf Me.IsEllipse AndAlso sAreteTest.IsEllipse Then
680		Dim vparam1 As Object = courbe1.GetEllipseParams()
681		Dim vparam2 As Object = courbe2.GetEllipseParams()
682		For i As Integer = 0 To 10
683	<	If Math.Abs(vparam1(i) - vparam2(i)) > Epsilon Then Return False
683	>	If Math.Abs(vparam1(i) - vparam2(i)) > 1000 * Epsilon Then Return False
684		Next
685		Return True
686	<	Else
687	<	Return False
686	>	Else ' peut-être des splines fermées...
687	>	' on fait un test sur ... ? 20 points ? ... sur une des 2 courbes, et si le point appartient à l'autre courbe aussi on retourne true
688	>	' la courbe Originale est me.swArete
689	>	Dim g As Integer = 0
690	>	Dim pointTest(2) As Double
691	>	Dim Tmin As Double = Me.GetTMin
692	>	Dim Tmax As Double = Me.GetTMax
693	>	Dim incrT As Double = (Tmax - Tmin) / 20
694	>
695	>
696	>	While g < 20
697	>	Me.Evaluer(Tmin + g * incrT, pointTest)
698	>	If Commun.Distance(sAreteTest.swArete, pointTest) > 0.000001 Then Return False ' merde, je déteste cette façon de procéder!
699	>	g += 1
700	>	End While
701	>
702	>
703	>	Return True
704		End If
705	<	End If
705	>	End If
706	>
707	>	If Distance(debut1, debut2) > 1000 * Epsilon AndAlso Distance(debut1, fin2) > 1000 * Epsilon Then Return False
708	>	If Distance(fin1, debut2) > 1000 * Epsilon AndAlso Distance(fin1, fin2) > 1000 * Epsilon Then Return False
709	>
710	>	' update, le point milieu ne marche pas toujours.., mais si on a une ligne, innutile de tester plus loin
711	>	If Me.IsLine And sAreteTest.IsLine Then Return True
712	>
713	>
714	>
715	>	'Dim D1() As Double = Me.GetTangenceDepart()
716	>	'Dim A1() As Double = Me.GetTangenceArivee()
717	>
718	>	'Dim D2() As Double = sAreteTest.GetTangenceDepart
719	>	'Dim A2() As Double = sAreteTest.GetTangenceArivee
720	>
721	>
722	>	'If Distance(debut1, debut2) < 1000 * Epsilon Then ' courbes dans même sens
723	>
724	>	'    If Outils_Math.ComparerVecteurs3D(D1, D2) AndAlso Outils_Math.ComparerVecteurs3D(A1, A2) Then Return True Else Return False
725	>	'Else ' courbes dans sens différent
726	>	'    Dim P1(2) As Double
727	>	'    Dim P2(2) As Double
728	>	'    If Outils_Math.ComparerVecteurs3D(D1, A2) = 1 AndAlso Outils_Math.ComparerVecteurs3D(A1, D2) = 1 Then Return True Else Return False
729	>	'End If
730	>
731	>
732	>	' une autre stratégie
733	>	Dim tmilieu As Double = Me.GetTMilieu
734	>	Dim xyz() As Double = Nothing
735	>	If Not Me.Evaluer(tmilieu, xyz) Then MsgBox("Marche pas ici...") ' alors prendre ce qu'il y a en commentaire plus haut....
736	>	Dim vPoint As Object = sAreteTest.swArete.GetClosestPointOn(xyz(0), xyz(1), xyz(2))
737	>	If Distance(xyz(0), xyz(1), xyz(2), vPoint(0), vPoint(1), vPoint(2)) < 0.000001 Then Return True Else Return False
738
612	–	If Distance(debut1, debut2) > Epsilon AndAlso Distance(debut1, fin2) > Epsilon Then Return False
613	–	If Distance(fin1, debut2) > Epsilon AndAlso Distance(fin1, fin2) > Epsilon Then Return False
739
615	–	' le pointmilieu est identique
616	–	Dim Milieu1() As Double = Me.GetPointMilieu()
617	–	Dim milieu2() As Double = sAreteTest.GetPointMilieu
618	–	If Distance(Milieu1, milieu2) > Epsilon Then Return False
740
620	–	Return True ' pourrait ne pas marcher dans certains cas fucké...
741		End Function
742
743	+
744		''' <summary>
745	<	''' Function qui calcule la longueur de l'arète
745	>	''' DOnne la longueur d'une arète
746		''' </summary>
747	<	''' <returns>La longueur de l'arrète</returns>
747	>	''' <value></value>
748	>	''' <returns>La longueur de l'arète</returns>
749		''' <remarks></remarks>
750	<	Public Function Longueur() As Double
751	<	Dim temp As Object
752	<	Dim T1 As Double, T2 As Double
753	<	Dim sommet As SldWorks.Vertex
754	<	Dim point As Object
750	>	Public ReadOnly Property Longueur() As Double
751	>	Get
752	>	Dim temp As Object
753	>	Dim T1 As Double, T2 As Double
754	>	Dim sommet As sldworks.Vertex
755	>	Dim point As Object
756
757	<	sommet = SwArete.GetStartVertex()
757	>	sommet = swArete.GetStartVertex()
758
759	<	If sommet IsNot Nothing Then
760	<	point = sommet.GetPoint() : temp = SwArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
761	<	sommet = SwArete.GetEndVertex() : point = sommet.GetPoint() : temp = SwArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
762	<	Return swCourbe.GetLength2(T1, T2)
759	>	If sommet IsNot Nothing Then
760	>	point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T1 = temp(0)
761	>	sommet = swArete.GetEndVertex() : point = sommet.GetPoint() : temp = swArete.GetParameter(point(0), point(1), point(2)) : T2 = temp(0)
762	>	Return swCourbe.GetLength2(T1, T2)
763
764	<	Else
765	<	'l'arète est fermée.
766	<	Dim params() As Double
767	<	If swCourbe.IsCircle Then
768	<	params = swCourbe.CircleParams
769	<	Return params(7) * Pi * 2
764	>	Else
765	>	'l'arète est fermée.
766	>	Dim params() As Double
767	>	If swCourbe.IsCircle Then
768	>	params = swCourbe.CircleParams
769	>	Return params(6) * Pi * 2
770	>	End If
771	>	MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver." & vbCr & "  On pourrait prendre la tessellation, mais là on aurait une approximation!")
772		End If
773	<	MsgBox("On demande la longueur d'une courbe fermée qui n'est pas un cercle... ce n'est pas encore programmé car ça ne devrait pas arriver.")
774	<	End If
775	<	End Function
773	>	End Get
774	>	End Property
775	>
776	>	''' <summary>
777	>	''' Si la courbe est un cercle, retourne le rayon.
778	>	''' </summary>
779	>	''' <value></value>
780	>	''' <returns></returns>
781	>	''' <remarks></remarks>
782	>	Public ReadOnly Property Rayon() As Double
783	>	Get
784	>	'MsgBox("Mettre du code ici")
785	>	Dim swCurve As sldworks.Curve = Me.swArete.GetCurve
786	>
787	>
788	>	If Me.IsCircle Then
789	>	Dim obj As Object = swCurve.CircleParams()
790	>	Return obj(6)
791	>	Else : Return (Nothing)
792	>	End If
793	>
794	>	End Get
795	>	End Property
796	>
797
798		''' <summary>
799		'''  Renvoie les coordonnées du point de départ
#	Line 655 | Line 801 | Public Class SuperArete
801		''' <returns></returns>
802		''' <remarks></remarks>
803		Public Function GetStartPoint() As Double()
804	<	Dim swSommet As SldWorks.Vertex
804	>	Dim swSommet As sldworks.Vertex
805		Dim retval As Object
806		Dim xyz(2) As Double
807	<	swSommet = Me.SwArete.GetStartVertex()
807	>	swSommet = Me.swArete.GetStartVertex()
808		If swSommet Is Nothing Then Return Nothing
809		retval = swSommet.GetPoint()
810		xyz = retval
#	Line 671 | Line 817 | Public Class SuperArete
817		''' <returns>Faux si le sommet n'esiste pas</returns>
818		''' <remarks></remarks>
819		Public Function GetStartPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
820	<	Dim swSommet As SldWorks.Vertex
820	>	Dim swSommet As sldworks.Vertex
821		Dim retval As Object
822		Dim xyz(2) As Double
823	<	swSommet = Me.SwArete.GetStartVertex()
823	>	swSommet = Me.swArete.GetStartVertex()
824		If swSommet Is Nothing Then Return False
825		retval = swSommet.GetPoint()
826		x = retval(0)
#	Line 684 | Line 830 | Public Class SuperArete
830		End Function
831
832		Public Function GetEndPoint() As Double()
833	<	Dim swSommet As SldWorks.Vertex
833	>	Dim swSommet As sldworks.Vertex
834		Dim retval As Object
835		Dim xyz(2) As Double
836	<	swSommet = Me.SwArete.GetEndVertex()
836	>	swSommet = Me.swArete.GetEndVertex()
837		If swSommet Is Nothing Then Return Nothing
838		retval = swSommet.GetPoint()
839		xyz = retval
#	Line 700 | Line 846 | Public Class SuperArete
846		''' <returns>Faux si le sommet n'esiste pas</returns>
847		''' <remarks></remarks>
848		Public Function GetEndPoint(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Boolean
849	<	Dim swSommet As SldWorks.Vertex
849	>	Dim swSommet As sldworks.Vertex
850		Dim retval As Object
851		Dim xyz(2) As Double
852	<	swSommet = Me.SwArete.GetEndVertex()
852	>	swSommet = Me.swArete.GetEndVertex()
853		If swSommet Is Nothing Then Return False
854		retval = swSommet.GetPoint()
855		x = retval(0)
#	Line 715 | Line 861 | Public Class SuperArete
861
862
863
864	+	''' <summary>
865	+	''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de départ de la courbe
866	+	''' </summary>
867	+	''' <returns>La tangence de la courbe</returns>
868	+	''' <remarks></remarks>
869	+	Public Function GetTangenceDepart() As Double()
870	+	Dim s1 As sldworks.Vertex = Me.SommetDebut
871	+	Dim es1 As New SuperSommet(s1, True)
872	+	Dim T As Double = Me.GetTMin
873
874	+	Dim tan(2) As Double
875	+	Me.Evaluer(T + 100 * Epsilon, tan)
876	+	tan(0) = es1.X - tan(0)
877	+	tan(1) = es1.Y - tan(1)
878	+	tan(2) = es1.Z - tan(2)
879
880	+	Return Outils_Math.unitaire(tan)
881
882	+	'Dim swCourbe As sldworks.Curve = Me.swArete.GetCurve
883	+	'Dim vTangent As Object = swCourbe.Evaluate(Me.GetTMin)
884	+	''[ PointX, PointY, PointZ, TangentX, TangentY, TangentZ, Success ]
885	+	'Dim dTangent(2) As Double
886	+	'dTangent(0) = vTangent(3) : dTangent(1) = vTangent(4) : dTangent(2) = vTangent(5)
887	+	'Return dTangent
888	+	End Function
889
890	+	''' <summary>
891	+	''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe
892	+	''' </summary>
893	+	''' <returns>La tangence de la courbe</returns>
894	+	''' <remarks></remarks>
895	+	Public Function GetTangenceArivee() As Double()
896	+	Dim s1 As sldworks.Vertex = Me.SommetFinal
897	+	Dim es1 As New SuperSommet(s1, True)
898	+	Dim T As Double = Me.GetTMax
899	+
900	+	Dim tan(2) As Double
901	+	Me.Evaluer(T - 100 * Epsilon, tan)
902	+	tan(0) = es1.X - tan(0)
903	+	tan(1) = es1.Y - tan(1)
904	+	tan(2) = es1.Z - tan(2)
905
906	+	Return Outils_Math.unitaire(tan)
907
908	+	End Function
909
910	+	''' <summary>
911	+	''' Retourne un tableau de 3 doubles représentant le vecteur de tangence au point de fin de la courbe
912	+	''' </summary>
913	+	''' <param name="T">La valuer de T à laquelle on cherche la tangence</param>
914	+	''' <returns>La tangence de la courbe</returns>
915	+	''' <remarks></remarks>
916	+	Public Function GetTangence(ByVal T As Double) As Double()
917	+	Dim s1 As sldworks.Vertex = Me.SommetFinal
918	+	Dim es1 As New SuperSommet(s1, True)
919
920	+	Dim tan(2) As Double
921	+	Me.Evaluer(T, tan)
922	+	tan(0) = es1.X - tan(0)
923	+	tan(1) = es1.Y - tan(1)
924	+	tan(2) = es1.Z - tan(2)
925	+
926	+	Return Outils_Math.unitaire(tan)
927	+
928	+	End Function
929	+
930	+
931	+	''' <summary>
932	+	''' Retourne le premier sommet de la courbe
933	+	''' </summary>
934	+	''' <value></value>
935	+	''' <returns></returns>
936	+	''' <remarks></remarks>
937	+	Public ReadOnly Property SommetDebut() As sldworks.Vertex
938	+	Get
939	+	Return Me.swArete.GetStartVertex
940	+	End Get
941	+	End Property
942	+
943	+	''' <summary>
944	+	''' Retourne le dernier sommet de la courbe
945	+	''' </summary>
946	+	''' <value></value>
947	+	''' <returns></returns>
948	+	''' <remarks></remarks>
949	+	Public ReadOnly Property SommetFinal() As sldworks.Vertex
950	+	Get
951	+	Return Me.swArete.GetEndVertex
952	+	End Get
953	+	End Property
954	+
955	+
956	+	''' <summary>
957	+	''' Sub utilisée pour le débuggage qui met 100 points sur la courbe
958	+	''' </summary>
959	+	''' <remarks>POur évaluer la tolérance</remarks>
960	+	Public Sub RemplirDePoints()
961	+	Dim T As Double, Tmin As Double, Tmax As Double, Tinc As Double
962	+	Dim P(2) As Double
963	+	swModel.Insert3DSketch2(False)
964	+
965	+	Tmin = Me.GetTMin
966	+	Tmax = Me.GetTMax
967	+	Tinc = (Tmax - Tmin) / 100
968	+	T = Tmin
969	+
970	+	For i As Integer = 0 To 100
971	+	T += Tinc
972	+	Me.Evaluer(T, P)
973	+	swModel.CreatePoint2(P(0), P(1), P(2))
974	+	Next i
975	+
976	+	swModel.Insert3DSketch2(False)
977	+	End Sub
978	+
979	+
980	+	''' <summary>
981	+	''' Sélectionne l'arète, mais s'assure de ne pas la désélectionner si elle est déjà sélectionnée
982	+	''' </summary>
983	+	''' <remarks>Pas très rapide...</remarks>
984	+	Public Sub SelectionnerSafe()
985	+	Dim swEnt As sldworks.Entity = Me.swArete
986	+	Dim selMgr As sldworks.SelectionMgr = swModel.SelectionManager
987	+
988	+	For i As Integer = 1 To selMgr.GetSelectedObjectCount2(-1)
989	+	If selMgr.GetSelectedObject6(i, -1) Is swEnt Then
990	+	Exit Sub
991	+	End If
992	+	Next
993	+
994	+	swEnt.Select4(True, Nothing)
995	+	End Sub
996	+
997	+
998	+	Public Sub PasserLes2FacesAdjascentes(ByRef swFace1 As sldworks.Face2, ByRef swFace2 As sldworks.Face2)
999	+	Dim obj As Object = Me.swArete.GetTwoAdjacentFaces2()
1000	+	swFace1 = obj(0)
1001	+	swFace2 = obj(1)
1002	+	End Sub
1003
1004		End Class

Diff Legend

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