during the course of my investigation of simplistic model ideas with large number of different outcomes, I found myself working on a circular stack of triangles which are defined by few simple parameters. each parameter was originally defined by the user (the coding was left within the script but deactivated), however, as I was going through different settings to get shapes which are very different from each other for testing purposes, I decided to fully randomise the script. I have settled for the boundary condition of 20 units randomly picked to speed up the process of the shape search. within a matter of several minutes I have generated some 30 random shapes which were eventually dubbed ‘spider evolution’. I’m now planning to expand the script or modify it for other purposes. the script is available for download.
.:script example:.
Option Explicit
‘Script written by shane gregoran
‘Script version 30 August 2010 00:20:56 updated 28 October 2010
Call p04TriangularSomethings()
Sub p04TriangularSomethings()
‘for this purpose all random numbers have been set to max of 20
‘Dim nPts : nPts = Rhino.GetReal(“how many segments”, 12)
Dim nPts : nPts = Floor(rnd*20)
If nPts < 3 Then
nPts = 3
End If
Dim cp : cp = Rhino.WorldXYPlane
cp(0)(2) = Floor(rnd*10)
‘Dim iR : iR = Rhino.GetReal(“length of short triangulation”,10)
Dim iR : iR = Floor(rnd*20)
If iR < 1 Then
iR = 1
End If
‘Dim R : R = Rhino.GetReal(“length of segments”,15)
Dim R : R = Floor(rnd*20)
If R < 1 Then
R = 1
End If
Dim iCirc, iLength, iPts
ReDim iPts(nPts)
iCirc = Rhino.AddCircle (cp,iR)
If Rhino.IsCurve(iCirc) Then
iLength = Rhino.CurveLength(iCirc)
End If
Dim i, S, iSc
For i = 0 To (nPts-1)
iSc = iLength/nPts
If i=0 Then
S=0
Else
S = iSc*i
End If
iPts(i) = Rhino.CurveArcLengthPoint(iCirc, S)
Next
Dim oCirc, oLength, oPts
ReDim oPts(nPts)
cp(0)(2) = Floor(rnd*10)
oCirc = Rhino.AddCircle (cp,R)
If Rhino.IsCurve(oCirc) Then
oLength = Rhino.CurveLength(oCirc)
End If
Dim outS, oSc
For i = 0 To (nPts-1)
oSc = oLength/nPts
If i=0 Then
outS=0
Else
outS = oSc*i
End If
oPts(i) = Rhino.CurveArcLengthPoint(oCirc, outS)
Next
‘Dim apxH : apxH = Rhino.GetReal(“height of apex guide curvature points”, 6)
Dim apxH : apxH = Floor(rnd*20)
Dim Origin, Direction, Normal, hPlane
Origin = array(0,0,apxH)
If IsArray(Origin) Then
Direction = array(0,0,apxH+1)
If IsArray(Direction) Then
Normal = VectorCreate(Direction, Origin)
Normal = VectorUnitize(Normal)
hPlane = Rhino.PlaneFromNormal(Origin, Normal)
End If
End If
‘Dim apxR : apxR = Rhino.GetReal(“distance of apex point from base”, 5)
Dim apxR : apxR = Floor(rnd*20)
If apxR < 1 Then
apxR = 1
End If
Dim hCirc, hLength, hPts
ReDim hPts(nPts-1)
hCirc = Rhino.AddCircle (hPlane,apxR)
If Rhino.IsCurve(hCirc) Then
hLength = Rhino.CurveLength(hCirc)
End If
Dim hS, hSc
For i = 0 To (nPts-1)
hSc = hLength/nPts
If i=0 Then
hS=hSc/2
Else
hS = (hSc/2)+(hSc*i)
End If
hPts(i) = Rhino.CurveArcLengthPoint(hCirc, hS)
Next
Dim wo : wo = array (0,0,(apxH/2))
Dim crvInnerPTS, crvOutterPTS, crvInnerPTSstring, crvOutterPTSstring
ReDim crvOutterPTS(nPts-1), crvInnerPTS(nPts-1), crvInnerPTSstring(nPts-1), crvOutterPTSstring(nPts-1)
For i = 0 To (nPts-1)
crvOutterPTS(i) = array(wo, hPts(i), oPts(i))
crvOutterPTSstring(i) = Rhino.AddCurve (crvOutterPTS(i))
Next
For i = 0 To (nPts-1)
If i = 0 Then
crvInnerPTS(i) = array(wo, hPts(nPts-2), iPts(i))
Else
If i = 1 Then
crvInnerPTS(i) = array(wo, hPts(nPts-1), iPts(i))
Else
crvInnerPTS(i) = array(wo, hPts(i-2), iPts(i))
End If
End If
crvInnerPTSstring(i) = Rhino.AddCurve (crvInnerPTS(i))
Next
Dim capCurve, capCurveString
ReDim capCurve(nPts-1), capCurveString(nPts-1)
For i = 0 To (nPts-1)
If i = (nPts-1) Then
capCurve(i) = array(oPts(i), hPts(i), iPts(1))
Else
If i = (nPts-2) Then
capCurve(i) = array(oPts(i), hPts(i), iPts(0))
Else
capCurve(i) = array(oPts(i),hPts(i), iPts(i+2))
End If
End If
capCurveString(i) = Rhino.AddCurve (capCurve(i))
Next
Dim LoftA, rr, LoftB, SurfA, rrr
ReDim LoftA(nPts-1), LoftB(nPts-1), SurfA(nPts-1)
For rr = 0 To nPts-1
If rr = nPts-2 Then
rrr = 0
Else
If rr = nPts-1 Then
rrr = 1
Else
rrr = rr + 2
End If
End If
LoftA(rr) = Array(crvOutterPTSstring(rr), crvInnerPTSstring(rrr), capCurveString(rr))
rhino.DeleteObject iCirc
rhino.DeleteObject oCirc
rhino.DeleteObject hCirc
Rhino.AddEdgeSrf LoftA(rr)
Next
End Sub
