Weitere Experimente mit rekursiven Elementen.

Ein interessanter Schritt wäre, die Wachstumsbedingungen über die Konfiguration der benachbarten Elemente zu verändern – ähnlich wie dies bei den 'zellulären Automaten' geschieht.

Der angegebene Code ist noch nicht optimiert, sondern Ergebnis des work in progress.

weiter >

 

'**********************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

 
 
\\ Entwurfsforschung \ Strukturexperimente \ autoCAD_VBA experimente