Discussion :

[Renaud976]

Bonjour à tous,

Je souhaiterais représenter une polyligne fermée (que j'ai sous forme de tableau X,Y en coordonnées réelles, en mm) sous la forme d'un solide extrudé (épaisseur E) et pouvoir le faire tourner (scrollbars ou souris).
Mes recherches n'ont rien donné de concluant et pas trop lourd.

J'imagine qu'il faut représenter une succession de rectangles (un rectangle pour chaque segment).
Auriez-vous un lien à me suggérer?

Bien cordialement,
Renaud.

[DarkVader]

Bonjour,
Fait une recherche du coté de Polypolygon et Rectangle de gdi32

[Renaud976]

Merci pour les mots-clés, je regarde.

Renaud.

[DarkVader]

Voir aussi avec Visual Basic+DirectX

[MABROUKI]

Bonjour Renaud97

Tu dois avoir de bon pre-requis en geometrie 3D :
-matrices 3d
-operations sur les matrices(multiplication,translation,rotation et mise à l'echelle)....
Ensuite pour planter une scene 3D il faut:
1-representation 3d de la scene soit:
-utiliser une structure Point3D (x,y,z) pour representer ton objet....
-disposer d'une "camera" pour voir la scene:soit un repere d'axe 3D
-translater les coords de ton objet 3d vers le repere "camera"
-convertir les coords 3d (x,y seulement) vers les coords de ton screen(ou viewport si tu utilises scalemode).....
2-pour dessiner à l'ecran on utilise (pauvrete d'outil en vb6)
-soit la methode line(x1,y1)-line(x2,y2) un cube par exemple (ou tout solide3d) est dessine en joignant ses sommets des lines....
-soit la methode API olygon qui dessine les cotes et en cadeau elle permet de filler les faces avec le FillColor de vb

Bref ce sont la des methodes utilises depuis QuickBasic et Gwbasic avec des ram de 512 kilooctets et toujours valable .......Ah le bon vieux temps....

1er Projet exemple : un cube anime dessine avec des "lines":
un fichier module "Mod3D.BAS" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
' Creating own definition
' represente un point3d
Type Point3d
  X As Long
  Y As Long
  Z As Long
End Type
' represente un point2d d'ecran
Type pixel
  X As Long
  Y As Long
End Type

	

	
Code  :
	
Sélectionner tout -
	Visualiser dans une fenêtre à part
	
123
 
 
un  simple form  avec un timer droppe dessus :
' Simple 3D Object (Cube)
' dessin avec methode Line(x,y)-(x2,y2)

' Variable declaration
Const CUBELINES = 12 - 1
Const PI As Double = 3.14152695


Dim CUBE(CUBELINES, 1) As Point3d 'real coords worlds
Dim s(CUBELINES, 1) As pixel      ' coords screen
Dim eye As Point3d                   ' eye position (camera)
Dim maxFormX As Long              ' width of screen
Dim maxFormY As Long              ' height of screen
Dim centerFormX As Long           ' center X  form
Dim centerFormY As Long           ' height Y  form
Dim ANGLE As Double               ' rotation angle

Dim strLines(CUBELINES) As String 'hold real coords as string


'explication CUBE:   Name of our object
' decrit Coords  World 3D(ou Coords Reelles) des sommets du Cube
'X1, Y1, Z1, X2, Y2, Z2
' -10, -10, -10, 10, -10, -10 'Line1(cote 1)
' -10, -10, -10, -10, 10, -10 'Line2
' -10, 10, -10, 10, 10, -10  'You know the rest
' 10, -10, -10, 10, 10, -10
' -10, -10, 10, 10, -10, 10
' -10, -10, 10, -10, 10, 10
' -10, 10, 10, 10, 10, 10
' 10, -10, 10, 10, 10, 10
' -10, -10, 10, -10, -10, -10
' -10, 10, 10, -10, 10, -10
' 10, 10, 10, 10, 10, -10
' 10, -10, 10, 10, -10, -10


Private Sub Form_Load()
     ' DrawMode
     Me.DrawMode = vbPixels
     
     ' Scale
     Me.Scale (0, 0)-(1000, 1000)
    ' Screen resolution ou viewport
     maxFormX = Me.ScaleWidth
     maxFormY = Me.ScaleHeight
 
    ' center X,Y  form
    centerFormX = Me.ScaleWidth / 2
    centerFormY = Me.ScaleHeight / 2
 
 
    ' Definition of object
    'X1, Y1, Z1, X2, Y2, Z2
    strLines(0) = " -10, -10, -10, 10, -10, -10" 'Line1
    strLines(1) = "-10, -10, -10, -10, 10, -10" 'Line2
    strLines(2) = "-10, 10, -10, 10, 10, -10"  'You know the rest
    strLines(3) = "10, -10, -10, 10, 10, -10"
    strLines(4) = "-10, -10, 10, 10, -10, 10"
    
    strLines(5) = "-10, -10, 10, -10, 10, 10"
    strLines(6) = "-10, 10, 10, 10, 10, 10"
    strLines(7) = "10, -10, 10, 10, 10, 10"
    strLines(8) = "-10, -10, 10, -10, -10, -10"
    strLines(9) = "-10, 10, 10, -10, 10, -10"
    strLines(10) = "10, 10, 10, 10, 10, -10"
    strLines(11) = "10, -10, 10, 10, -10, -10"
   

    
    ' Read Object Data Cube
     Dim i As Integer
     Dim tmp(5) As String
     For i = 0 To CUBELINES
          temp = Split(strLines(i), ",")
        
          CUBE(i, 0).X = CLng(temp(0))
          CUBE(i, 0).Y = CLng(temp(1))
          CUBE(i, 0).Z = CLng(temp(2))
          CUBE(i, 1).X = CLng(temp(3))
          CUBE(i, 1).Y = CLng(temp(4))
          CUBE(i, 1).Z = CLng(temp(5))
     Next
   
    ' Set Eye position (c'est la Cameraa ou toi dans le vaiseau d'espace)
    ' peut etre change
    
    eye.X = 10
    eye.Y = 30
    eye.Z = 100

    ' Calculate the eye coordinates(camera)
    ' convertit  coords 3D du cube =>  repere 3d camera
    For i = 0 To CUBELINES
      CUBE(i, 0).X = CUBE(i, 0).X - eye.X
      CUBE(i, 0).Y = CUBE(i, 0).Y - eye.Y
      CUBE(i, 0).Z = CUBE(i, 0).Z - eye.Z
      CUBE(i, 1).X = CUBE(i, 1).X - eye.X
      CUBE(i, 1).Y = CUBE(i, 1).Y - eye.Y
      CUBE(i, 1).Z = CUBE(i, 1).Z - eye.Z
    Next i

    ' Calculate screen coordinates
    ' convertit  coords 3D du cube => repere 2d Ecran
    For i = 0 To CUBELINES
      s(i, 0).X = maxFormX * (CUBE(i, 0).X / CUBE(i, 0).Z) + centerFormX
      s(i, 0).Y = maxFormY * (CUBE(i, 0).Y / CUBE(i, 0).Z) + centerFormY
      s(i, 1).X = maxFormX * (CUBE(i, 1).X / CUBE(i, 1).Z) + centerFormX
      s(i, 1).Y = maxFormY * (CUBE(i, 1).Y / CUBE(i, 1).Z) + centerFormY
    Next i
  
    ANGLE = 0#
    Me.Timer1.Interval = 25
    Me.Timer1.Enabled = True
    
End Sub
Private Sub Timer1_Timer()
   AnimationLoop
End Sub
Private Sub AnimationLoop()
    Me.Refresh
    ANGLE = ANGLE + PI / 180
    
End Sub

Private Sub Form_Paint()
    ' Draw object
    DrawObject
End Sub

Private Sub DrawObject()
    
    ' Rotation des points 3d du cube
    Dim j As Integer
    Dim pwork As Point3d
    For j = 0 To CUBELINES
      pwork = CUBE(j, 0)
      rotateZ pwork, ANGLE
      rotateY pwork, ANGLE
      vec2pix pwork, s(j, 0)
      
      pwork = CUBE(j, 1)
      rotateZ pwork, ANGLE
      rotateY pwork, ANGLE
      vec2pix pwork, s(j, 1)
      
    Next j
   
    Me.BackColor = vbWhite
    Me.FillColor = vbRed
    Me.ForeColor = vbYellow
    Me.FillStyle = vbSolid
    Me.DrawWidth = 2#
    Dim i As Integer
    Dim X1, Y1, X2, Y2 As Long
    For i = 0 To CUBELINES
       X1 = s(i, 0).X
       Y1 = s(i, 0).Y
       X2 = s(i, 1).X
       Y2 = s(i, 1).Y
       'pour accelerer on ne dessine pas les cotes non -visibles
       ' du cube
       If CUBE(i, 0).Z < eye.Z And CUBE(i, 1).Z < eye.Z Then
            Line (X1, Y1)-(X2, Y2)
       End If
    Next i

End Sub


Private Sub Form_Resize()
 
   maxFormX = Me.ScaleWidth
   maxFormY = Me.ScaleHeight
   
   centerFormX = Me.ScaleWidth / 2
   centerFormY = Me.ScaleHeight / 2
    ' Update screen coordinates on resize
    For i = 0 To CUBELINES
      s(i, 0).X = maxFormX * (CUBE(i, 0).X / CUBE(i, 0).Z) + centerFormX
      s(i, 0).Y = maxFormY * (CUBE(i, 0).Y / CUBE(i, 0).Z) + centerFormY
      s(i, 1).X = maxFormX * (CUBE(i, 1).X / CUBE(i, 1).Z) + centerFormX
      s(i, 1).Y = maxFormY * (CUBE(i, 1).Y / CUBE(i, 1).Z) + centerFormY
    Next i
    Me.Refresh
End Sub


' Calculating the eye coordinates(camera)
'& conversion en coords d'ecran

Private Sub vec2pix(objpt As Point3d, scrpix As pixel)
  
    'update eye coords(camera)
    objpt.X = objpt.X - eye.X
    objpt.Y = objpt.Y - eye.Y
    objpt.Z = objpt.Z - eye.Z
    
    If objpt.Z = 0 Then Exit Sub
    'update screen coords
    scrpix.X = (objpt.X / objpt.Z) * maxFormX + centerFormX
    scrpix.Y = (objpt.Y / objpt.Z) * maxFormY + centerFormY
End Sub
' Rotating Point around X-Axis
'   objpt : point3d  in world coordinates (!)
'   alpha : angle to rotate around X-Axis (1 means 0.1 deg)

Private Sub rotateX(objpt As Point3d, alpha As Double)
  
  Dim p As Point3d

  p.X = (objpt.X * Math.Cos(alpha) - objpt.Y * Math.Sin(alpha))
  p.Y = (objpt.Y * Math.Sin(alpha) + objpt.Y * Math.Cos(alpha))

  objpt.X = p.X
  objpt.Y = p.Y
End Sub
' Rotating Point around Y-Axis
'   objpt : point3d in world coordinates (!)
'   beta  : angle to rotate around Y-Axis (1 means 0.1 deg)

Private Sub rotateY(objpt As Point3d, beta As Double)
  
  Dim p As Point3d

  p.X = (objpt.X * Math.Cos(beta) + objpt.Z * Math.Sin(beta))
  p.Z = (objpt.X * -Math.Sin(beta) + objpt.Z * Math.Cos(beta))

  objpt.X = p.X
  objpt.Z = p.Z
End Sub
' Rotating Point around Z-Axis
'   objpt : point3d in world coordinates (!)
'   gamma : angle to rotate around Y-Axis (1 means 0.1 deg)

Private Sub rotateZ(objpt As Point3d, gamma As Double)

  Dim p As Point3d
 
  p.Y = (objpt.Y * Math.Cos(gamma) - objpt.Z * Math.Sin(gamma))
  p.Z = (objpt.Y * Math.Sin(gamma) + objpt.Z * Math.Cos(gamma))

  objpt.Y = p.Y
  objpt.Z = p.Z
End Sub

et voile qui pourrait faire ton bonheur.....
2eme Projet exemple : comment dessiner "sans effort" un polygon (5,6 8 ou -N cotes ) avec l'API Polygon:
un fichier module "ModAPI.BAS" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 Option Base 1
    Public Type POINTAPI
            X As Long
            Y As Long
    End Type
 
 
    Public Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
    Public Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
 
'  la fonction et ses sous-fonctions qui genere les points d'un polygone regulier 
' à -N-cotes   
Const PI as Double= 3.14159
 
 
 Public Sub CalculateVertices(Sides As Integer, _
                                    Radius As Integer, StartingAngle As Integer, _
                                    Center As POINTAPI, points() As POINTAPI)
 
     If (Sides < 3) Then
     MsgBox ("Polygon must have 3 sides or more.")
     Exit Sub
     End If
     Dim pt As POINTAPI
     Dim stp As Single
     stp = 360# / Sides
     Dim angle As Single
     angle = StartingAngle    'starting angle
 
     ' go in a full circle
     Dim i As Double
     i = StartingAngle
 
     Dim k As Integer
     k = 1
     Do While i < StartingAngle + 360#
 
          pt = DegreesToXY(angle, CSng(Radius), Center)
          'rem code snippet from above
          points(k) = pt
          k = k + 1
 
          angle = angle + stp
          i = i + stp
     Loop
 
 
 
End Sub
'Calculates a point that is at an angle from the origin (0 is to the right)
 
Public Function DegreesToXY(degrees As Single, Radius As Single, origin As POINTAPI) As POINTAPI
 
    Dim xy As POINTAPI
    Dim radians As Double
    radians = degrees * PI / 180#
 
    xy.X = CSng(Math.Cos(radians) * Radius + origin.X)
    xy.Y = CSng(Math.Sin(-radians) * Radius + origin.Y)
 
    DegreesToXY = xy
End Function
'Calculates the angle a point is to the origin (0 is to the right)
 
Public Function XYToDegrees(xy As POINTAPI, origin As POINTAPI) As Single
 
    Dim deltaX As Integer
    deltaX = origin.X - xy.X
    Dim deltaY As Integer
    deltaY = origin.Y - xy.Y
 
    Dim radAngle As Double
    radAngle = Math.Atn(deltaY / deltaX)
    Dim degreeAngle  As Double
    degreeAngle = radAngle * 180# / PI
 
   XYToDegrees = CSng(180# - degreeAngle)
 
End Function

Un form pour tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
    Option Base 1
    Const numpoints As Integer = 5
     'Partie 2D qui genere le polygone(ici Pentagone....)
 
    Private Sides As Integer
    Private Radius As Integer
    Private StartingAngle As Integer
    Private Center As POINTAPI
    Private Pentagone(numpoints) As POINTAPI
 
 
   Private Sub Form_Load()
 
 
     Me.DrawMode = vbPixels
     Me.ScaleWidth = 600
     Me.ScaleHeight = 800
     Me.ScaleLeft = 0
     Me.ScaleTop = 0
 
 
     'Cree Polygone
     Sides = numpoints
     Radius = 50
     StartingAngle = 0
     Center.X = 50
     Center.Y = 50
 
     CalculateVertices Sides, Radius, StartingAngle, Center, Pentagone
 
    End Sub
 
 
Private Sub Form_Paint()
 
      DrawPolygon
End Sub
 
Private Sub Form_Resize()
    sx = ScaleWidth / Me.Width
    sy = ScaleHeight / Me.Height
 
    ' Draw the polygon.
    Me.Refresh
End Sub
Private Sub DrawPolygon()
    FillStyle = vbFSSolid
    FillColor = vbBlue
    ForeColor = vbYellow
    DrawWidth = 2
 
    Polygon Me.hdc, Pentagone(1), numpoints
 
 
End Sub

3eme Projet exemple : plus consistant utilise nos connaissances
-pour generer polygon (un pentagone exemple ) et le dupliquer ...
-utilise les 2 pentagones pour creer 2 surfaces 3d à 5 cotes...
-decale le Z de la 2eme surface de 200 par rapport à la 1ere...
-de plus definit le solide (pentagedron) extrude en distinguant chaque face
(2 faces haut et bas ,5 faces laterales) grace à la numerotation des sommets(vertex)...
-utilise un class versatile pour faire tourner les points du pentahedron...
-un camera bien sur.....
fichier module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
  Option Base 1
    Public Type POINTAPI
            X As Long
            Y As Long
    End Type
 
 
    Public Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
    Public Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
 
Const PI as Double= 3.14159
 
 
 Public Sub CalculateVertices(Sides As Integer, _
                                    Radius As Integer, StartingAngle As Integer, _
                                    Center As POINTAPI, points() As POINTAPI)
 
     If (Sides < 3) Then
     MsgBox ("Polygon must have 3 sides or more.")
     Exit Sub
     End If
     Dim pt As POINTAPI
     Dim stp As Single
     stp = 360# / Sides
     Dim angle As Single
     angle = StartingAngle    'starting angle
 
     ' go in a full circle
     Dim i As Double
     i = StartingAngle
 
     Dim k As Integer
     k = 1
     Do While i < StartingAngle + 360#
 
          pt = DegreesToXY(angle, CSng(Radius), Center)
          'rem code snippet from above
          points(k) = pt
          k = k + 1
 
          angle = angle + stp
          i = i + stp
     Loop
 
 
 
End Sub
'Calculates a point that is at an angle from the origin (0 is to the right)
 
Public Function DegreesToXY(degrees As Single, Radius As Single, origin As POINTAPI) As POINTAPI
 
    Dim xy As POINTAPI
    Dim radians As Double
    radians = degrees * PI / 180#
 
    xy.X = CSng(Math.Cos(radians) * Radius + origin.X)
    xy.Y = CSng(Math.Sin(-radians) * Radius + origin.Y)
 
    DegreesToXY = xy
End Function
'Calculates the angle a point is to the origin (0 is to the right)
 
Public Function XYToDegrees(xy As POINTAPI, origin As POINTAPI) As Single
 
    Dim deltaX As Integer
    deltaX = origin.X - xy.X
    Dim deltaY As Integer
    deltaY = origin.Y - xy.Y
 
    Dim radAngle As Double
    radAngle = Math.Atn(deltaY / deltaX)
    Dim degreeAngle  As Double
    degreeAngle = radAngle * 180# / PI
 
   XYToDegrees = CSng(180# - degreeAngle)
 
End Function

fichier de class Point3D.BAS

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
''************************************************
'           le versatile class  Point3d
'''************************************************
 
 Const PI = 3.14159
 
'local variable(s) to hold property value(s)
Private mvarX As Double 'local copy
Private mvarY As Double 'local copy
Private mvarZ As Double 'local copy
 
 
 
 
 
Private Sub Class_Initialize()
mvarX = 0#
mvarY = 0#
mvarZ = 0#
 
End Sub
 
 
Public Sub Init(ByVal pX As Double, ByVal pY As Double, ByVal pZ As Double)
 
 
 Me.X = pX
 Me.Y = pY
 Me.Z = pZ
 
End Sub
Public Function rotateX(Optional ByVal angle As Integer) As Point3D
    Dim rad As Double
    Dim cosa As Double
    Dim sina As Double
    Dim Yn As Double
    Dim Zn As Double
 
    rad = angle * PI / 180
    cosa = Math.Cos(rad)
    sina = Math.Sin(rad)
    Yn = Me.Y * cosa - Me.Z * sina
    Zn = Me.Y * sina + Me.Z * cosa
 
    Dim p As New Point3D
 
    Call p.Init(Me.X, Yn, Zn)
    Set rotateX = p
End Function
Public Function rotateY(ByVal angle As Integer) As Point3D
    Dim rad As Double
    Dim cosa As Double
    Dim sina As Double
    Dim Xn As Double
    Dim Zn As Double
 
    rad = angle * PI / 180
    cosa = Math.Cos(rad)
    sina = Math.Sin(rad)
    Zn = Me.Z * cosa - Me.X * sina
    Xn = Me.Z * sina + Me.X * cosa
    Dim p As New Point3D
 
    Call p.Init(Xn, Me.Y, Zn)
    Set rotateY = p
 End Function
 
Public Function rotateZ(ByVal angle As Integer) As Point3D
    Dim rad As Double
    Dim cosa As Double
    Dim sina As Double
    Dim Xn As Double
    Dim Yn As Double
 
    rad = angle * PI / 180
    cosa = Math.Cos(rad)
    sina = Math.Sin(rad)
    Xn = Me.X * cosa - Me.Y * sina
    Yn = Me.X * sina + Me.Y * cosa
 
    Dim p As New Point3D
 
    Call p.Init(Xn, Yn, Me.Z)
    Set rotateZ = p
End Function
 
Public Property Let Z(ByVal vData As Double)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Z = 5
    mvarZ = vData
End Property
 
 
Public Property Get Z() As Double
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Z
    Z = mvarZ
End Property
 
 
 
Public Property Let Y(ByVal vData As Double)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Y = 5
    mvarY = vData
End Property
 
 
Public Property Get Y() As Double
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Y
    Y = mvarY
End Property
 
 
 
Public Property Let X(ByVal vData As Double)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.X = 5
    mvarX = vData
End Property
 
 
Public Property Get X() As Double
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.X
    X = mvarX
End Property

fichier forme avec un timer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
 
  ''************************************************
    '           le form  frmPentageExtrudeSimple
    '''************************************************
 
    Option Base 1
    'Partie 2D qui genere le polygone(ici le Pentagone....)
    Const numpoints As Integer = 5
    Private Sides As Integer
    Private Radius As Integer
    Private StartingAngle As Integer
    Private Center As POINTAPI
    Private PentagoneTop(numpoints) As POINTAPI
    Private PentagoneBottom(numpoints) As POINTAPI
 
   'Partie 3D qui genere le pentahydron par extrusion
    Dim m_vertices(1 To 12) As Point3D  'les sommets numerotes ou vertex
    'les faces reperees par leur sommets numerotes ....c'est ca le plus delicat.....
    Dim m_facesTop(1, 5) As Integer     'la face du haut  avec 5 sommets... c'est ca le plus delicat.....
    Dim m_facesBottom(1, 5) As Integer  'la face du bas  avec 5 sommets...idem.
    Dim m_facesLateral(5, 4) As Integer 'les  faces laterales avec 4 sommets chacune....
 
 
    Dim eye As Point3D                ' eye position (camera)
    Dim m_angle As Double             'angle de rotation
 
    Dim maxFormX As Long              ' width of screen
    Dim maxFormY As Long              ' height of screen
    Dim centerFormX As Long           ' center X  form
    Dim centerFormY As Long           ' height Y  form
 
 
 
 
    Private Sub Form_Load()
        m_angle = 0
        Me.BackColor = vbWhite
        Me.ScaleMode = vbPixels
 
       ' Scale
        Me.Scale (1000, 1000)-(4000, 4000)
        ' Screen resolution
         maxFormX = Me.ScaleWidth
         maxFormY = Me.ScaleHeight
 
        ' center X,Y  form
        centerFormX = Me.ScaleWidth / 2
        centerFormY = Me.ScaleHeight / 2
 
       ' Set Eye position (c'est la Cameraa ou toi dans le vaiseau d'espace)
        ' peut etre change
        Set eye = New Point3D
        eye.X = 0
        eye.Y = 0
        eye.Z = 128
 
 
        'Cree Polygone
        Sides = numpoints
        Radius = 50
        StartingAngle = 0
        Center.X = 50
        Center.Y = 50
 
        CalculateVertices Sides, Radius, StartingAngle, Center, PentagoneTop
 
       'recopie le PentagoneTop dans PentagoneBottom
        Dim i As Integer
        For i = 1 To Sides
           PentagoneBottom(i) = PentagoneTop(i)
        Next i
 
        ' cree le solide 3d PentaHedron
        Call CreatePentaHedron(PentagoneTop, PentagoneBottom)
 
        ' Set the timer interval to 25 milliseconds. This will give us 1000/25 ~ 40 frames per second.
        Me.Timer1.Interval = 25
 
        ' Start the timer.
        Me.Timer1.Enabled = True
        animate = True
    End Sub
 
    Private Sub CreatePentaHedron(TopPts() As POINTAPI, BottomPts() As POINTAPI)
        ' Create the cube vertices.
        Dim pt As Point3D
       ' Numero des sommets
       Dim numVertices As Integer
 
       Dim k As Integer
       ' Numero de 1 à 5 vertices  top
       nVertices = 0
       For k = 1 To numpoints
            Set pt = New Point3D
            pt.X = TopPts(k).X
            pt.Y = TopPts(k).Y
            pt.Z = 300#            'profondeur Z de 300
            numVertices = numVertices + 1
            Set m_vertices(numVertices) = pt
        Next
 
 
 
        ' 6 à 10  vertices  bottom.
         For k = 1 To numpoints
           Set pt = New Point3D
           pt.X = BottomPts(k).X
           pt.Y = BottomPts(k).Y
           pt.Z = 500#           'profondeur Z de 500(extrusion de 500-300=200)
           numVertices = numVertices + 1
           Set m_vertices(numVertices) = pt
        Next
 
 
        ' Create an array representing the 7 faces of a Pentahydron.
        ' Each face is composed by indices to the vertex array
        ' above.
        ' store vertices Face top
         For k = 1 To 5
          m_facesTop(1, k) = k
         Next
 
        ' store vertices Face bottom
         For k = 1 To 5
          m_facesBottom(1, k) = k + 5
         Next
 
        ' store vertices Face Lateral
        m_facesLateral(1, 1) = 1
        m_facesLateral(1, 2) = 2
        m_facesLateral(1, 3) = 7
        m_facesLateral(1, 4) = 6
 
        m_facesLateral(2, 1) = 2
        m_facesLateral(2, 2) = 3
        m_facesLateral(2, 3) = 8
        m_facesLateral(2, 4) = 7
 
        m_facesLateral(3, 1) = 3
        m_facesLateral(3, 2) = 4
        m_facesLateral(3, 3) = 9
        m_facesLateral(3, 4) = 8
 
        m_facesLateral(4, 1) = 4
        m_facesLateral(4, 2) = 5
        m_facesLateral(4, 3) = 10
        m_facesLateral(4, 4) = 9
 
        m_facesLateral(5, 1) = 5
        m_facesLateral(5, 2) = 1
        m_facesLateral(5, 3) = 6
        m_facesLateral(5, 4) = 10
 
        ' coords 3D cube => camera
        For k = 1 To 10
           m_vertices(k).X = m_vertices(k).X - eye.X
           m_vertices(k).Y = m_vertices(k).Y - eye.Y
           m_vertices(k).Z = m_vertices(k).Z - eye.Z
        Next k
 
 
 
 
 
    End Sub
    Private Sub Form_Resize()
         sx = Me.ScaleWidth
         sy = Me.ScaleHeight
         Me.Refresh
    End Sub
   Private Sub Timer1_Timer()
       AnimationLoop
    End Sub
 
    Private Sub AnimationLoop()
        ' Forces the Paint event to be called.
        Me.Refresh
 
        ' Update the variable after each frame.
        m_angle = m_angle + 1
 
 
    End Sub
 
    Private Sub Form_Paint()
        Dim t(12) As Point3D
        Dim f(4) As Integer
        Dim v As Point3D
        Dim avgZ(5) As Double           'moyenne des coord Z faces laterales
        Dim avgZTop(1) As Double        'moyen. des coord Z face haut
        Dim avgZbottom(1) As Double     'moyen. des coord Z face bas
        Dim orderTop(1) As Integer        'ordre de dessin  face top(1 seule pas de probleme....hein)
        Dim orderBottom(1) As Integer    'ordre de dessin  face bottom
        Dim order(5) As Integer         'ordre de dessin  faces laterales
        Dim tmp As Double
 
        For i = 1 To 10
           Set v = m_vertices(i)
           'rotation X-Y-Z
            Set t(i) = v.rotateX(m_angle).rotateY(m_angle).rotateZ(m_angle)
 
        Next i
 
        ' Compute the average Z value of  face top.
 
        avgZTop(1) = (t(m_facesTop(1, 1)).Z + _
        t(m_facesTop(1, 2)).Z + t(m_facesTop(1, 3)).Z + _
        t(m_facesTop(1, 4)).Z + t(m_facesTop(1, 5)).Z) / 5#
        orderTop(1) = 1
 
 
       ' Compute the average Z value of  face bottom.
 
        avgZbottom(1) = (t(m_facesBottom(1, 1)).Z + _
        t(m_facesBottom(1, 2)).Z + t(m_facesBottom(1, 3)).Z + _
        t(m_facesBottom(1, 4)).Z + t(m_facesBottom(1, 5)).Z) / 5#
        orderBottom(1) = 1
 
        ' Compute the average Z value of lateral face.
        For i = 1 To 5
           avgZ(i) = (t(m_facesLateral(i, 1)).Z + _
           t(m_facesLateral(i, 2)).Z + t(m_facesLateral(i, 3)).Z + t(m_facesLateral(i, 4)).Z) / 4#
           order(i) = i
        Next
 
 
      ' Draw the faces using the PAINTERS ALGORITHM (distant faces first, closer faces last).
      ' (algo du peintre Leonard de Vinci...)
 
        Dim index As Integer
        Me.FillStyle = vbSolid
        Me.DrawWidth = 1
 
         'Lateral faces
        Me.ForeColor = RGB(255, 0, 0)
        Me.FillColor = RGB(100 * Rnd, 150 * Rnd, 255 * Rnd)
 
        Me.DrawWidth = 1
        Dim tempPointsB(4) As POINTAPI
        For i = 1 To 5
            index = order(i)
 
            'CurrentX = CLng(t(m_facesLateral(index, 1)).X)
            'CurrentY = CLng(t(m_facesLateral(index, 1)).Y)
 
            For k = 1 To 4
               'Line -(CLng(t(m_facesLateral(index, k)).X), CLng(t(m_facesLateral(index, k)).Y)), vbRed
                tempPointsB(k).X = CLng(t(m_facesLateral(index, k)).X)
                tempPointsB(k).Y = CLng(t(m_facesLateral(index, k)).Y)
            Next
            Polygon Me.hdc, tempPointsB(1), 4
        Next
 
       'top face
 
        Me.ForeColor = vbCyan
        Me.FillColor = vbBlue
 
        Dim tmpPointsA(5) As POINTAPI
 
 
        index = orderTop(1)
        'CurrentX = CLng(t(m_facesTop(index, 1)).X)
        'CurrentY = CLng(t(m_facesTop(index, 1)).Y)
 
        For k = 1 To 5
              'Line -(CLng(t(m_facesTop(index, k)).X), CLng(t(m_facesTop(index, k)).Y)), vbRed
              tmpPointsA(k).X = CLng(t(m_facesTop(index, k)).X)
              tmpPointsA(k).Y = CLng(t(m_facesTop(index, k)).Y)
        Next
        Polygon Me.hdc, tmpPointsA(1), 5
 
        'bottom face
        Me.ForeColor = vbYellow
        Me.FillColor = vbRed
        index = orderBottom(1)
 
        'CurrentX = CLng(t(m_facesBottom(index, 1)).X)
        'CurrentY = CLng(t(m_facesBottom(index, 1)).Y)
 
        For k = 1 To 5
            'Line -(CLng(t(m_facesBottom(index, k)).X), CLng(t(m_facesBottom(index, k)).Y)), vbRed
             tmpPointsA(k).X = CLng(t(m_facesBottom(index, k)).X)
             tmpPointsA(k).Y = CLng(t(m_facesBottom(index, k)).Y)
 
        Next
        Polygon Me.hdc, tmpPointsA(1), 5
 
    End Sub

nota -bene : j'ai laisse en "comment out" les lignes de code si tu veux dessiner ton pentagone extrude avec la methode line(x1,y1)-(x2,y2)......

voila qui j'espere fera ton bonheur..............

bon code............