'**********************Das Skript erzeugt eine Wachstumsstruktur durch Iteration******************
'
Private loser() As Long
Private koord(0 To 2) As Double
Private oneSlice
Private f As Integer
Private u As Integer
Private etage As Double
Private durchlauf As Integer
Private max As Integer
Private startpoint(2) As Double
Private endpoint(2) As Double
Private mengeWuerfel As Integer
Private astZahl As Integer

Sub main() '---Initialisierung
Dim num As Double, amount As Integer
Dim startTrip(0 To 2) As Double, default As Variant, messagge As Variant
num = 4
max = 1

'---InputBox für die Anzahl der Würfel
messagge = "geben Sie die Anzahl der Würfel an"
default = "300"
mengeWuerfel = InputBox(messagge, , default)

'---InputBox für die Zahl der Verzweigungen
messagge = "geben Sie die Anzahl der Verzweigungen an"
default = "3"
astZahl = InputBox(messagge, , default)

ReDim loser(mengeWuerfel) As Long '---Die Indevariable zur bestimmung des vorhergehenden Astes
startTrip(0) = 0
startTrip(1) = 0
startTrip(2) = -10
oneSlice = pi * 2 / num
durchlauf = 0
ThisDrawing.SendCommand "_erase" & vbCr & "all" & vbCr
ThisDrawing.SendCommand vbCr
setzeQuad startTrip, 10 'Der Samen

create 0 '---Die Iteration wird gestartet und läft bis mengeWürfel erreicht ist
End Sub

Sub create(i As Integer) '---Berechnung der Postion der jeweiligen Würfel
Dim num As Double, m As Integer
Dim angle As Double
Dim mitte(0 To 2) As Double
num = 4

For m = 0 To astZahl - 1 '---Anzahl der Verästelung
Dim Centroid As Variant
Dim baddy As AcadObject
Set baddy = ThisDrawing.ObjectIdToObject(loser(i)) '---Der Basisast wird durch die Indexvariable i aufgerufen und die Koordinaten an baddy übergeben
Centroid = baddy.Centroid
koord(0) = Centroid(0)
koord(1) = Centroid(1)
koord(2) = Centroid(2)
Randomize

'---Richtung des nächsten Würfels berechnen
angle = Round((Rnd() * num + 1)) * oneSlice
' Koordinaten berechnen und Würfel zeichnen
koord(0) = Round(koord(0) + Cos(angle) * (m + 2) * 11, 0)
koord(1) = Round(koord(1) + Sin(angle) * (m + 2) * 11, 0)
mitte(0) = koord(0): mitte(1) = koord(1): mitte(2) = etage
setzeQuad mitte, 10

'---Bestimmt den Start- und Endpunkt der Verbindungslinien
startpoint(0) = Centroid(0): startpoint(1) = Centroid(1): startpoint(2) = Centroid(2)
endpoint(0) = koord(0): endpoint(1) = koord(1): endpoint(2) = etage
draw_line startpoint, endpoint, durchlauf
Next m
'---Berechnung der Indexvariablen des Basisastes
If u >= max - 1 Then
u = 0: etage = etage + 22: durchlauf = durchlauf + 1 '---durchlauf zählt die Iterationsschritte
Else
u = u + 1
End If
max = astZahl ^ durchlauf
create (f - ((u * astZahl - u) + max)) '---der entsprechende Index des Basisastes wird an create übergeben
End Sub

Sub draw_line(here() As Double, there() As Double, segment As Integer) '---zeichnen der Verbindungslinie

Dim begin(2) As Double, finish(2) As Double
Dim path As AcadLine

'---Linie zeichnen
Set path = ThisDrawing.ModelSpace.AddLine(here, there)
path.color = segment + 1
path.Update

End Sub

Sub setzeQuad(mittelPunkt() As Double, elevation As Double) 'zeichnen der Würfel
Dim wuerfel As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double
Dim cont As Long

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

' Würfel erstellen
Set wuerfel = ThisDrawing.ModelSpace.AddBox(center, length, width, height)

wuerfel.color = durchlauf + 1
loser(f) = wuerfel.ObjectID

f = f + 1 '---Zählt die und Indexiert Würfel

ThisDrawing.Regen acActiveViewport
If f = mengeWuerfel Then End '---Wenn die maximale Anzahl an Würfel = menge Würfel, erreicht ist wird das Programm abgebrochen
ZoomAll
End Sub

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

Function pi() '---Berechnung der Zahl Pi
pi = (Atn(1) * 4)
End Function