ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/REPOS_ERICCA/magicsld/SuperCourbe.vb
Revision: 130
Committed: Wed Jul 30 21:26:03 2008 UTC (16 years, 9 months ago) by bournival
File size: 2996 byte(s)
Log Message:
Une mise à jour, car on aura peut-être besoin de mon code.

File Contents

# Content
1 Imports SolidWorks.Interop
2 Imports SolidWorks.Interop.swconst
3 Imports SolidWorks.Interop.swpublished
4
5 Public Class SuperCourbe
6 ' classe utilisée uniquement pour des fonctions temporaires sur les courbes...
7 Private swCourbe As sldworks.Curve
8
9 Public Sub New(ByRef courbe As sldworks.curve)
10 Me.swCourbe = courbe
11 End Sub
12
13
14 ''' <summary>
15 ''' Fonction qui retourne le Tmax de l'arète
16 ''' </summary>
17 ''' <returns>Tmax</returns>
18 ''' <remarks></remarks>
19 Public Function GetTMax() As Double
20 Dim vp As Object
21 swCourbe.GetCurve()
22 vp = swCourbe.GetCurveParams2()
23 Return vp(7)
24 End Function
25
26
27 ''' <summary>
28 ''' Détermine si la valeur de T est sur la courbe, si oui ça retourne les coordonnées XYZ
29 ''' </summary>
30 ''' <param name="T"></param>
31 ''' <param name="xyz"></param>
32 ''' <returns></returns>
33 ''' <remarks></remarks>
34 Public Function Evaluer(ByRef T As Double, Optional ByRef xyz() As Double = Nothing) As Boolean
35
36 Dim temp(2) As Double
37 Dim retval As Object
38 Dim retour() As Double
39 Dim T1 As Double
40 Dim T2 As Double
41
42 retval = Me.swCourbe.GetCurveParams2()
43 retour = retval
44 T1 = retour(6)
45 T2 = retour(7)
46
47 If Not ((T >= T1) And (T <= T2)) Then Return False
48
49 retval = Me.swCourbe.Evaluate(T)
50
51 temp(0) = retval(0)
52 temp(1) = retval(1)
53 temp(2) = retval(2)
54
55 xyz = temp
56
57 Return True
58
59 End Function
60 ''' <summary>
61 ''' Fonction qui retourne le Tmin de l'arète
62 ''' </summary>
63 ''' <returns>Tmax</returns>
64 ''' <remarks></remarks>
65 Public Function GetTMin() As Double
66 Dim vp As Object
67 swCourbe.GetCurve()
68 vp = Me.swCourbe.GetCurveParams2()
69 Return vp(6)
70
71
72 End Function
73
74 ''' <summary>
75 ''' Function qui retourne la valeur de T de cette courbe
76 ''' </summary>
77 ''' <param name="x"></param>
78 ''' <param name="y"></param>
79 ''' <param name="z"></param>
80 ''' <returns></returns>
81 ''' <remarks></remarks>
82 Public Function GetT(ByRef x As Double, ByRef y As Double, ByRef z As Double) As Double
83 Dim retval As Object
84 Dim retour(1) As Double
85 retval = Me.swCourbe.GetParameter(x, y, z)
86 retour = retval
87 If Not retour(1) Then
88 Dim ret As Object = Me.swCourbe.GetClosestPointOn(x, y, z)
89 Dim distance As Double = Math.Sqrt((x - ret(0)) ^ 2 + (y - ret(1)) ^ 2 + (z - ret(2)) ^ 2)
90 'MsgBox("GetT n'a pas fonctionné pour cette arête." & vbCr & distance & vbCr & vbCr & "xyz = " & x & " " & y & " " & z & vbCr & "Closest " & ret(0) & " " & ret(1) & " " & ret(2), MsgBoxStyle.Critical)
91 Return 0 ' mouais, c'est le cas dans les situations que j'ai vues...
92 End If
93 Return retour(0)
94 End Function
95
96
97 End Class