'**********************Das Skript erzeugt eine
Wachstumsstruktur durch Iteration******************
'
Private loser() As Long
Private koord(0 To 2) As Double
Private oneSlice
Private f As Integer, u As Integer
Private etage As Double
Private durchlauf As Integer
Private max As Double
Private startpoint(2) As Double
Private endpoint(2) As Double
Private mengeWuerfel As Integer
Private astZahl As Integer
Private num As Integer
Private checkList() As Variant
Private Ktod As Double
Private KtodGesamt As Double
Private KtodAlt As Double
Sub main() '---Initialisierung
Dim amount As Integer, default As Variant, messagge As Variant
Dim startTrip(0 To 2) As Double
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 = "2"
astZahl = InputBox(messagge, , default)
ReDim checkList(mengeWuerfel) As Variant '---Liste mit den besetzten
Positionen
ReDim loser(mengeWuerfel) As Long '---Die Indevariable zur bestimmung
des vorhergehenden Astes
checkList(0) = startTrip
checkList(0)(0) = 1
startTrip(0) = 0
startTrip(1) = 0
startTrip(2) = 40
oneSlice = pi * 2 / num
durchlauf = 0
ThisDrawing.SendCommand "_erase" & vbCr & "all"
& vbCr
ThisDrawing.SendCommand vbCr
setzeQuad startTrip '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 m As Integer, s As Integer
Dim angle As Double
Dim mitte(0 To 2) As Double
For m = 0 To astZahl - 1 '---Anzahl der Verästelung
Dim Centroid As Variant, check As Boolean
Dim baddy As AcadObject
'If i > f Or i < 0 Then InputBox (ende): End
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
check = True
'---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) * 11, 0)
koord(1) = Round(koord(1) + Sin(angle) * 11, 0)
mitte(0) = koord(0): mitte(1) = koord(1): mitte(2) = koord(2)
For s = 1 To f
' Würfelposition wird anhand des checkList-Arrays auf Doppelbelegung
überprüft
If mitte(0) = checkList(s)(0) And mitte(1) = checkList(s)(1) And
mitte(2) = checkList(s)(2) Then
' Wenn Position bereits besetzt, verschiebung nach oben oder unten
'etage = etage + 11
'mitte(2) = etage
check = False
End If
Next s
If check Then '---Wenn Positione noch frei, setze Würfel
und zeichne Linie
setzeQuad mitte
'---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) =
koord(2)
draw_line startpoint, endpoint, durchlauf
Else '---Wenn Position besetzt erhöhe den Zähler Ktod
um die nichtbesetzten Felder zu speichern
Ktod = Ktod + 1
End If
Next m
'---Berechnung der Indexvariablen des Basisastes
If u >= max - 1 Then
u = 0: durchlauf = durchlauf + 1: '---durchlauf zählt die
Iterationsschritte
KtodGesamt = (KtodGesamt + KtodAlt) * astZahl '---errechnet die
Zahl aller nicht gesetzter Würfel
max = (astZahl ^ durchlauf) - Ktod - KtodGesamt '---um den richtigen
Basisast zu finden wird die Anzahl der nichtgesetzten Würfel
von der Anzahl aller möglichen abgezogen
KtodAlt = Ktod
Ktod = 0
Else
u = u + 1
End If
create (f - (u * astZahl - Ktod) + 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) '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)
height = 6
length = 6
width = 6
' Würfel erstellen
Set wuerfel = ThisDrawing.ModelSpace.AddBox(center, length, width,
height)
wuerfel.color = durchlauf + 1
'wuerfel.ScaleEntity center, 1 / (durchlauf / 4 + 1)
'wuerfel.Rotate center, u
loser(f) = wuerfel.ObjectID
f = f + 1 '---Zählt und indexiert Würfel
checkList(f) = center
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