1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
| Imports System
Imports System.IO
Imports System.Security.Permissions
Public Class Form1
Public fichier As String
Dim Xoff As Single
Dim Yoff As Single
Dim Zoff As Single
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim i As Integer, n As Integer
Dim j As Integer, m As Integer
m = 180
n = 200
'Ici on génére une surface de révolution complexe
'- axe de rotation autour de Y
'- profil de révolution qui tourne autour de l'axe Y : R1
'- profil définissant la symètrie de la révolution : R2 - pour avoir un vrai solide de révolution R2 doit être un cercle
'mais en faisant varier R2 en fonction de Y et en fonction de l'angle A, on peut avoir des formes très complexes (par exemple un hexagone vrillé conique)
Dim A As Single
Dim Y As Single, Yprec As Single
Dim Ymin As Single, Ymax As Single
Dim Xmin As Single, Xmax As Single
Dim Zmin As Single, Zmax As Single
Dim XX As Single, ZZ As Single
Dim X(m) As Single, Xprec(m) As Single
Dim Z(m) As Single, Zprec(m) As Single
Dim R1 As Single, R2 As Single, R As Single
'Dim Header As String
Dim head As Byte
Dim NbTriangles As UInt32
'Il faut écrire l'entête du fichier :
fichier = My.Application.Info.DirectoryPath + "\Exemple.STL"
Dim binWriter As New BinaryWriter(File.Open(fichier, FileMode.Create))
head = 0
'Header = Space(80)
'binWriter.Write(Header)
For i = 1 To 80
binWriter.Write(head)
Next
'Il faut écrire le nombre de triangles :
NbTriangles = n * m * 2
binWriter.Write(NbTriangles)
'Recherche des mini et maxi :
For i = 0 To n
Y = Calcul_Y(i, n)
If i = 0 Then
Ymin = Y
Ymax = Y
Else
If Y < Ymin Then Ymin = Y
If Y > Ymax Then Ymax = Y
End If
R1 = Calcul_R1(Y, Ymin, Ymax)
For j = 1 To m
A = j * 2 * Math.PI / m
R2 = Calcul_R2(A, i, m)
R = R1 * R2
XX = -R * Math.Sin(A)
ZZ = R * Math.Cos(A)
If i = 0 And j = 1 Then
Xmin = XX
Xmax = XX
Zmin = ZZ
Zmax = ZZ
Else
If XX < Xmin Then Xmin = XX
If XX > Xmax Then Xmax = XX
If ZZ < Zmin Then Zmin = ZZ
If ZZ > Zmax Then Zmax = ZZ
End If
Next j
Next i
'Calcul des décalages pour qu'aucun point de triangle ne soit négatif :
Xoff = 1 - Xmin
Yoff = 1 - Ymin
Zoff = 1 - Zmin
'Calcul des triangles :
For i = 0 To n
Y = Calcul_Y(i, n)
R1 = Calcul_R1(Y, Ymin, Ymax)
For j = 1 To m
A = j * 2 * Math.PI / m
R2 = Calcul_R2(A, i, m)
R = R1 * R2
X(j) = -R * Math.Sin(A)
Z(j) = R * Math.Cos(A)
If i > 0 And j > 1 Then
Call Triangle(binWriter, Xprec(j - 1), Yprec, Zprec(j - 1), Xprec(j), Yprec, Zprec(j), X(j), Y, Z(j))
Call Triangle(binWriter, Xprec(j - 1), Yprec, Zprec(j - 1), X(j), Y, Z(j), X(j - 1), Y, Z(j - 1))
End If
Next j
If i > 0 Then
Call Triangle(binWriter, Xprec(m), Yprec, Zprec(m), Xprec(1), Yprec, Zprec(1), X(1), Y, Z(1))
Call Triangle(binWriter, Xprec(m), Yprec, Zprec(m), X(1), Y, Z(1), X(m), Y, Z(m))
End If
For j = 1 To m
Xprec(j) = X(j)
Zprec(j) = Z(j)
Next
Yprec = Y
Next i
'on ferme le fichier
binWriter.Close()
MsgBox("Fichier créé")
End Sub
Private Sub Triangle(br As BinaryWriter, x1 As Single, y1 As Single, z1 As Single, x2 As Single, y2 As Single, z2 As Single, x3 As Single, y3 As Single, z3 As Single)
Dim nx As Single, ny As Single, nz As Single
Dim Attr As UInt16
Dim norme As Single
'Décalage :
x1 = x1 + Xoff
y1 = y1 + Yoff
z1 = z1 + Zoff
x2 = x2 + Xoff
y2 = y2 + Yoff
z2 = z2 + Zoff
x3 = x3 + Xoff
y3 = y3 + Yoff
z3 = z3 + Zoff
'Calcul vecteur normal :
nx = (y2 - y1) * (z3 - z1) - (z2 - z1) * (y3 - y1)
ny = (z2 - z1) * (x3 - x1) - (x2 - x1) * (z3 - z1)
nz = (x2 - x1) * (y3 - y1) - (y2 - y1) * (x3 - x1)
norme = Math.Sqrt(nx * nx + ny * ny + nz * nz)
nx = nx / norme
ny = ny / norme
nz = nz / norme
'Attribut :
Attr = 0
'Ecriture :
br.Write(nx)
br.Write(ny)
br.Write(nz)
br.Write(x1)
br.Write(y1)
br.Write(z1)
br.Write(x2)
br.Write(y2)
br.Write(z2)
br.Write(x3)
br.Write(y3)
br.Write(z3)
br.Write(Attr)
End Sub
Private Function Calcul_R1(Y As Single, Ymin As Single, Ymax As Single) As Single
Calcul_R1 = 50 + ((Y - (Ymax - Ymin) / 2) / 20) ^ 2
End Function
Private Function Calcul_R2(A As Single, i As Integer, m As Integer) As Single
Calcul_R2 = 1 + 0.5 * (Math.Cos(A + i * 2 * Math.PI / m)) ^ 2
End Function
Private Function Calcul_Y(i As Integer, n As Integer)
Calcul_Y = i * 300 / n
End Function
End Class |
