Sub setzeQuad(mittelPunkt() As Double, elevation As Double)
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(1, 255)
End Sub

Sub main()
Dim i As Integer
Dim u As Integer
Dim etage As Double
Dim loops As Integer
Dim test As Integer
Dim mitte(0 To 2) As Double
Dim checkList(0 To 200) As Variant
loops = 200
Dim oneSlice As Double
Dim angle As Double
Dim xW As Double
Dim yW As Double
Dim entscheid As Integer
Dim num As Double
test = 0
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
For u = 0 To i - 1
If mitte(0) = checkList(u)(0) And mitte(1) = checkList(u)(1) And mitte(2) = checkList(u)(2) Then test = 1
Next u
If test = 1 Then
checkList(i) = mitte
etage = etage + random(-1, 1) * 10#
angle = Round((Rnd() * num + 1)) * oneSlice
mitte(0) = xW: mitte(1) = yW: mitte(2) = etage
xW = Round(xW + Cos(angle) * 11, 0)
yW = Round(yW + Sin(angle) * 11, 0)
setzeQuad mitte, 10#
Else
checkList(i) = mitte
angle = Round((Rnd() * num + 1)) * oneSlice
mitte(0) = xW: mitte(1) = yW: mitte(2) = etage
xW = Round(xW + Cos(angle) * 11, 0)
yW = Round(yW + Sin(angle) * 11, 0)
setzeQuad mitte, 10#
End If
test = 0
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