Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 'Generates a Penrose staircase in Excel using Anik Soulière's tool for visualisation in R3
- 'Link to download the file :
- 'https://www.dropbox.com/s/yg52g3kgxhpisrq/Algeb_ConcoursObjet_3D_EscalierPenrose_avecScript.xlsm?dl=0
- 'Sorry it's in French honhonhon
- Private Type point
- x As Single
- y As Single
- z As Single
- End Type
- Private Enum escalier1
- 'CONSTANTES ATTRIBUABLES AUX MARCHES
- '"nbre_" correspondant au nombre de marches (_ = côté)
- nbre1 = 5
- nbre2 = 5
- nbre3 = 3
- nbre4 = 1
- nbre5 = 0
- nbre7 = 2
- nbre8 = 4
- 'Lignes et colonnes initiales
- Linit = 9
- Cinit = 28
- End Enum
- Sub Main()
- 'INITIALISATIONS
- Dim cePoint As point, precPoint As point
- Dim hauteur As Single, giron As Single
- hauteur = 0.2
- giron = 2
- Dim nbreMarches As New Collection
- nbreMarches.Add 5
- nbreMarches.Add 5
- nbreMarches.Add 4
- nbreMarches.Add 1
- nbreMarches.Add 0
- nbreMarches.Add 0
- nbreMarches.Add 3
- nbreMarches.Add 4
- nbreMarches.Add 5
- Dim cellPres As Range
- Dim compteur As Integer
- compteur = 0
- Dim priorite As Boolean
- priorite = 0
- Dim Ccour As Integer
- Ccour = Cinit
- Dim orientation As Integer
- orientation = 1
- 'Base
- Set cellPres = Cells(Linit, 16)
- cePoint.x = 6
- cePoint.y = 6
- cePoint.z = 0
- precPoint = cePoint
- Call base(cePoint, cellPres, giron, hauteur, nbreMarches)
- cePoint.z = cePoint.z + hauteur * 3
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- Ccour = cellPres.Column
- 'Marches
- For orientation = 1 To 9
- Select Case orientation
- Case 1
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = 0
- Case 2
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = 0
- Case 3
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = 0
- 'Ccour = Ccour - 1
- Case 4
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = 0
- Ccour = Ccour - 1
- Case 5
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- Ccour = Ccour - 1
- Case 6
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- Case 7
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = True
- Case 8
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = True
- Case 9
- Set cellPres = Cells(Linit, Ccour)
- limite = nbreMarches.Item(orientation)
- priorite = True
- End Select
- precPoint.x = Cells(cellPres.Row, cellPres.Column - 1).Value
- precPoint.y = Cells(cellPres.Row + 1, cellPres.Column - 1).Value
- precPoint.z = Cells(cellPres.Row + 2, cellPres.Column - 1).Value
- For compteur = 0 To limite Step 1
- If priorite = 0 Then
- 'Donne longueur à la marche
- cePoint = avancerPoint(precPoint, giron, orientation)
- Call imprPoint(cePoint, cellPres)
- precPoint = cePoint
- Set cellPres = Cells(cellPres.Row, cellPres.Column + 1)
- Ccour = Ccour + 1
- Call barreTransversale(cePoint, cellPres, orientation, Ccour, giron)
- priorite = 1
- End If
- If priorite = True Then
- If orientation = 1 Or orientation = 2 Or orientation = 3 Or orientation = 4 Then
- If compteur = limite Then Exit For
- ElseIf orientation = 9 Then
- If compteur = limite Then
- hauteur = 3 * hauteur
- Call barreTransversale(cePoint, cellPres, 3, Ccour, giron)
- End If
- End If
- 'Monte vers porchaine marche
- cePoint = monterPoint(precPoint, hauteur, orientation)
- Call imprPoint(cePoint, cellPres)
- precPoint = cePoint
- Set cellPres = Cells(cellPres.Row, cellPres.Column + 1)
- Ccour = Ccour + 1
- Call barreTransversale(cePoint, cellPres, orientation, Ccour, giron)
- priorite = 0
- End If
- Next compteur
- compteur = 0
- Next orientation
- End Sub
- Function avancerPoint(precPoint As point, ByVal giron As Single, ByVal orientation As Integer) As point
- avancerPoint.x = precPoint.x
- avancerPoint.y = precPoint.y
- avancerPoint.z = precPoint.z
- Select Case orientation
- Case 1, 5, 7
- avancerPoint.y = precPoint.y - giron
- Case 2, 6
- avancerPoint.x = precPoint.x - giron
- Case 3, 9
- avancerPoint.y = precPoint.y + giron
- Case 4, 8
- avancerPoint.x = precPoint.x + giron
- End Select
- End Function
- Function monterPoint(precPoint As point, ByVal hauteur As Single, ByVal orientation As Integer, Optional toutPlus As Boolean = False) As point
- monterPoint.x = precPoint.x
- monterPoint.y = precPoint.y
- monterPoint.z = precPoint.z
- Select Case orientation
- Case 1, 2, 3, 4
- monterPoint.z = precPoint.z + hauteur
- Case 5
- monterPoint.z = IIf(toutPlus, precPoint.z + hauteur, precPoint.z)
- Case 6, 7, 8, 9
- monterPoint.z = IIf(toutPlus, precPoint.z + hauteur, precPoint.z - hauteur)
- End Select
- End Function
- Sub barreTransversale(point As point, cellu As Range, orientation As Integer, ByRef Ccour As Integer, giron As Single)
- Dim pointTrans As point
- pointTrans.x = point.x
- pointTrans.y = point.y
- pointTrans.z = point.z
- Select Case orientation
- Case 1
- pointTrans.x = pointTrans.x - giron
- Case 2
- pointTrans.y = pointTrans.y + giron
- Case 3
- pointTrans.x = pointTrans.x + giron
- Case 4
- pointTrans.y = pointTrans.y - giron
- End Select
- 'If orientation <= 4 Then
- Call imprPoint(pointTrans, cellu)
- Set cellu = Cells(cellu.Row, cellu.Column + 1)
- Ccour = Ccour + 1
- Call imprPoint(point, cellu)
- Set cellu = Cells(cellu.Row, cellu.Column + 1)
- Ccour = Ccour + 1
- 'End If
- End Sub
- 'Affecte les valeurs d'un point aux cellules correspondantes
- Sub imprPoint(point As point, cellu As Range)
- Dim coo As Single
- For i = 0 To 2
- Select Case i
- Case 0
- coo = point.x
- Case 1
- coo = point.y
- Case 2
- coo = point.z
- End Select
- Cells(cellu.Row + i, cellu.Column).Value = coo
- Next i
- End Sub
- Sub base(cePoint As point, cellPres As Range, giron As Single, hauteur As Single, nbreMarches As Collection)
- Dim pointInit As point
- Dim pointInit2 As point
- pointInit = cePoint
- Dim nMarchesParc As Integer
- nMarchesParc = 0
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- For i = 1 To 9
- For j = 0 To nbreMarches(i) - IIf(i < 7, 0, 1)
- cePoint = avancerPoint(cePoint, giron, i)
- nMarchesParc = IIf(i < 7, nMarchesParc + 1, nMarchesParc - 1)
- Next j
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- pointInit2 = cePoint
- cePoint.z = cePoint.z + hauteur * 3
- For j = 2 To nMarchesParc
- cePoint = monterPoint(cePoint, hauteur, i, IIf(i < 5, False, True))
- Next j
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- cePoint = pointInit2
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- nMarchesParc = nMarchesParc - 1
- Next i
- cePoint = pointInit
- Call imprPoint(cePoint, cellPres)
- Set cellPres = Cells(Linit, cellPres.Column + 1)
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement