Sub setzeQuad(mittelPunkt() As Double, elevation As Double)
' Dim num As Integer num = 4
Dim wuerfel As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double

' Angaben für den wuerfel
center(0) = mittelPunkt(0): center(1) = mittelPunkt(1): center(2) = mittelPunkt(2) - elevation / 2
height = elevation
length = 10
width = 10

' Würfel erstellen
Set wuerfel = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
wuerfel.color = random(0, 255)
End Sub

Sub main()
Dim i As Integer, u As Integer, loops As Integer, entscheid As Integer
Dim etage As Double, oneSlice As Double, angle As Double, xW As Double, yW As Double, num As Double
Dim mitte(0 To 2) As Double
loops = 400
Dim checkList(0 To 400) As Variant
Dim check As Boolean, break As Boolean
num = 4
oneSlice = pi * 2 / num
checkList(0) = mitte
checkList(0)(0) = 1#
etage = u
xW = 0
yW = 0
u = 0

For i = 1 To loops
check = True

For u = 0 To i - 1
' Würfelposition wird anhand des checkList-Arrays auf Doppelbelegung überprüft
If mitte(0) = checkList(u)(0) And mitte(1) = checkList(u)(1) And mitte(2) = checkList(u)(2) Then
' Wenn Position bereits besetzt, verschiebung nach oben oder unten
etage = etage + random(-1, 1) * 10#
check = False
End If
Next u

' Wenn keine Doppelbelegung
If check Then
'Richtung des nächsten Würfels berechnen
angle = Round((Rnd() * num + 1)) * oneSlice
mitte(0) = xW: mitte(1) = yW: mitte(2) = etage

' mitte an checklist-Array übergeben
checkList(i) = mitte

' Koordinaten berechnen und Würfel zeichnen
xW = Round(xW + Cos(angle) * 11, 0)
yW = Round(yW + Sin(angle) * 11, 0)
setzeQuad mitte, 10#

' mitte-Array aktualisieren für Positionskontrolle
mitte(0) = xW: mitte(1) = yW: mitte(2) = etage

Else ' Bei Doppelbelegung wird lediglich die Höhe verändert und die checkList erweitert, damit die Laufvariable nicht auf ein unbesetztes Array-Feld verweist
mitte(2) = etage
checkList(i) = checkList(i - 1)

End If

Next i

ZoomAll
End Sub

Function random(lower As Double, upper As Double)
random = Int((upper - lower + 1) * Rnd + lower)
End Function

Function pi()
pi = (Atn(1) * 4)
End Function