(n)certainties – Columbia – Fall 2008

Option Explicit
‘Midterm Script
‘Script written by
‘Script copyrighted by
‘Script version Thursday, October 09, 2008 6:46:58 PM

Dim ReachMax, ReachMin, arrMnMx, Zstep, Iterations, MaxVaultDist, DblFctr, MaxComrades, kissingDist, MinVaultDist, EQMin, zLimit, Lyrs
Dim shtRd, ShtGap, zwiggle, xywiggle, ExplodeStop

shtRd = 2
ShtGap = 0.4*shtRd
ReachMax = 80
ReachMin = 9
Zstep = 2
Iterations = 5
MaxVaultDist = 90
DblFctr = 1.1
‘MaxComrades = 3
kissingDist = 5
MinVaultDist = 6
EQMin= 14
zLimit = 40
Lyrs = 5
arrMnMx = array(ReachMin, ReachMax)
zwiggle= array(Zstep*0.2, Zstep*1.2)
xywiggle = array(-0.2, 0.2)
ExplodeStop = 1.8*ReachMin + ReachMin

Call Main()
Sub Main()

‘Select shit slinging robots
Dim ObjPts, Arrpts(), i, j, MyFirstComrade, vpts, NewPts, vpsID, p, s, t, L, poo, text, Lay

ObjPts = Rhino.GetObjects (“Select your shit slinging robots”, 1)
For i=0 To Ubound (ObjPts)
ReDim Preserve Arrpts(i)
Arrpts(i) = Rhino.PointCoordinates (ObjPts(i))
Next

L=5
poo = 0
For t = 0 To Iterations-1
Rhino.EnableRedraw (False)
For s=0 To Iterations-1

MyFirstComrade = FindComrade1 (Arrpts)
If IsNull (MyFirstComrade) Then
Exit For
End If
If L Mod 5 = 0 Then
Rhino.EnableRedraw (True)
Rhino.EnableRedraw (False)
‘Rhino.AddLayer “Stack”&poo
‘Rhino.AddLayer “Points”&poo,,,,”Stack”&poo
‘Rhino.CurrentLayer “Points”&poo
poo=poo+1
End If

L=L+1
vpts = MyFirstComrade(1)
vpsID = MyFirstComrade(0)
NewPts = Build (vpts, poo)

For p=0 To Ubound (vpsID)
Lay = Rhino.CurrentLayer ()
‘Rhino.AddLayer “Dots”
‘Rhino.AddLayer “Dot”&vpsID(p),,,,”Dots”
‘Rhino.CurrentLayer “Dot”&vpsID(p)
Arrpts(vpsID(p)) = NewPts(p)
text = Rhino.AddTextDot (vpsID(p), Arrpts(vpsID(p)))
Rhino.TextObjectHeight text , 100
Rhino.CurrentLayer Lay

Next
‘Rhino.EnableRedraw (True)
Next
Next

Rhino.EnableRedraw (True)

‘ measure distance between

‘ if robots are close enough to build, build

‘build

‘ create a point to build towards
‘ move there
‘ if span becomes too far abort
‘ if they grow together stop
‘ upon exit, deposit points inot their respective array

‘ store robot history in master array

‘ select one pont form each array in master array

‘ redo the function
End Sub

Function FindComrade1 (arrpts)

Dim Alpha, AlphaComrade, arrVaulters, VaulterID, n, q, d, j, k, g, m, arrRestore(), y, w
Dim TestWin, TestJ, TestK, d_A, d_B, d_C, lineTestLength, d_Avg, EQScore, LosersID(), arrLosers(), WinEqScore
Dim zAlpha, zQ, zDif
‘ choose a random point in array to begin

arrVaulters = Null

For y = 0 To Ubound (arrpts)
ReDim Preserve arrRestore(y)
arrRestore(y) = arrpts(y)
Next

Alpha = RndptINarray(arrpts)
AlphaComrade = arrpts(Alpha)

n=0
w=0

For q = 0 To Ubound (arrpts)
If IsNull (arrpts(q))Then
Else
If q Alpha Then
zAlpha= AlphaComrade(2)
zQ= arrpts(q)(2)
zDif= abs(zAlpha-zQ)
d = Rhino.Distance (array(AlphaComrade(0),AlphaComrade(1), 0) , array(arrpts(q)(0), arrpts(q)(1), 0))
If d > MaxVaultDist Or zDif > zLimit Or d < MinVaultDist Then
ReDim Preserve LosersID (n)
ReDim Preserve arrLosers (n)
arrLosers(n) = arrpts(q)
LosersID (n) = q
n=n+1
Else
w=w+1
End If
End If
End If
Next

For m=0 To Ubound (LosersID)
arrpts(LosersID(m)) = Null
Next

If w<2 Then
For y = 0 To Ubound (arrRestore)
ReDim Preserve arrpts(y)
arrpts(y) = arrRestore(y)
Next
FindComrade1 = Null
Exit Function
End If

g=0

For j=0 To Ubound (arrpts)
If IsNull (arrpts(j)) Then
Else
If jAlpha Then
For k=j To Ubound (arrpts)
If IsNull (arrpts(k)) Then
Else
If k j Then
TestWin = Rhino.PointAdd (AlphaComrade, array(0,0,-1*AlphaComrade(2)))
TestJ = Rhino.PointAdd (arrpts(j), array(0,0,-1*arrpts(j)(2)))
TestK = Rhino.PointAdd (arrpts(k), array(0,0,-1*arrpts(k)(2)))
d_A = Rhino.Distance(TestWin,TestJ)
d_B = Rhino.Distance(TestWin,TestK)
d_C = Rhino.Distance(TestJ,TestK)
lineTestLength = d_A + d_B + d_C
d_Avg = (d_A+d_B+d_C)/3
EQScore = abs(d_Avg-d_A)+abs(d_Avg-d_B)+abs(d_Avg-d_C)/(d_A+d_B+d_C)
If EQScore < EQMin Then
WinEqScore = EQScore
arrVaulters = array(arrpts(Alpha), arrpts(j), arrpts(k))
VaulterId = array(Alpha, j, k)
End If
End If
End If
Next
End If
End If
Next

If IsNull(arrVaulters) Then
For y = 0 To Ubound (arrRestore)
ReDim Preserve arrpts(y)
arrpts(y) = arrRestore(y)
Next
FindComrade1 = Null
Exit Function
End If

If EQScore = Empty Then
For y = 0 To Ubound (arrRestore)
ReDim Preserve arrpts(y)
arrpts(y) = arrRestore(y)
Next
FindComrade1 = Null
Exit Function
End If

For y = 0 To Ubound (arrRestore)
ReDim Preserve arrpts(y)
arrpts(y) = arrRestore(y)
Next

FindComrade1 = Array (VaulterId, arrVaulters)

End Function

Function Build (arrpts,poo)

Dim intcnter, arrd(), arrCntrPt, CntrVect, math, xyVect(), hold(), Built(), b, n, v, p, j, m, z
Dim i, another, magicNumber, y
Dim StreamQ(), StreamR(), StreamW(),q, r, w
Dim crvpt(), Curve1, Circles(), c, arrplane
Dim x, Curve2(), arrExplode, d, daLayer, daParent
Dim StreamCrvs0(), StreamCrvs1(), StreamCrvs2(), sc1, sc2, sc0

intcnter = FindCenter (arrpts)
n=0
b = 0
z = Zstep
q=0
r=0
w=0
For m=0 To Ubound (arrpts)
ReDim Preserve OrigD(m)
OrigD(m) = Rhino.Distance(arrpts(m),intcnter)
Next

Do

For p=0 To Ubound (arrpts)
For j=p To Ubound (arrpts)
If pj Then
ReDim Preserve arrd(n)
arrd(n) = Rhino.Distance(arrpts(p), arrpts(j))
n=n+1
If IsNull (arrd(n-1)) Then
Exit Do
End If
If Rhino.Max (arrd) < kissingDist Then
Exit Do
End If
End If
Next
Next

n=0
arrCntrPt = FindCenter (arrpts)
‘CntrVect = Rhino.VectorCreate (arrCntrPt, arrMainCntrpt)
‘CntrVect = Rhino.VectorScale (CntrVect, 0.03)
‘arrCntrPt = Rhino.PointAdd(arrCntrPt,CntrVect)

For v=0 To Ubound (arrpts)

‘Rhino.AddLayer v
‘Rhino.CurrentLayer v

math = ((DblFctr*(OrigD(v))^2-z)/DblFctr)
If math ExplodeStop Then
arrExplode = Rhino.ExplodeCurves (Curve2(x), True)
If IsNull (arrExplode) Then
Else
Select Case x
Case 0
Rhino.DeleteObject arrExplode(1)
FinCrv = Rhino.JoinCurves (array(arrExplode(0), arrExplode(2)), True)
div=Rhino.DivideCurveLength (FinCrv(0),ShtGap)
For sht = 0 To Ubound (div)
‘Rhino.AddSphere div(sht), shtRd
Next
Case 1
Rhino.DeleteObject arrExplode(0)
ReDim Preserve StreamCrvs1 (sc1)
StreamCrvs1(sc1) = arrExplode(1)
sc1= sc1+1
Case 2
Rhino.DeleteObject arrExplode(0)
ReDim Preserve StreamCrvs2 (sc2)
StreamCrvs2(sc2) = arrExplode(1)
sc2= sc2+1
End Select
End If
End If
End If
Next

For d=0 To Ubound (Circles)
Rhino.DeleteObject (Circles(d))

Next
Rhino.DeleteObject (Curve1)

Rhino.CurrentLayer “Points”&poo-1

Loop

Rhino.AddLayer (“Streams”)
Rhino.CurrentLayer (“Streams”)

If IsArray (StreamQ) And q>1 Then
Rhino.AddInterpCurve (StreamQ)
End If
If IsArray (StreamR) And r>1 Then
Rhino.AddInterpCurve (StreamR)
End If
If IsArray (StreamW) And w>1 Then
Rhino.AddInterpCurve (StreamW)
End If

Rhino.CurrentLayer(“Defalt”)
If q>2 Then
arrpts(0) = StreamQ(RndptINarray(StreamQ))
End If

If r>2 Then
arrpts(1) = StreamR(RndptINarray(StreamR))
End If

If w>2 Then
arrpts(2) = StreamW(RndptINarray(StreamW))
End If

Build = arrpts
‘For i=0 To ubound (arrpts)
‘Rhino.AddSphere arrpts(i),5
‘ Next

Rhino.CurrentLayer “Points”&poo-1
End Function

Function RndptINarray(arrpts)
Dim nMax, nMin, i

For i=0 To Ubound(arrpts)

Next

nMax= i-1
nMin= 1

RndptINarray = Null
If Not IsNumeric(nMin) Then Exit Function
If Not IsNumeric(nMax) Then Exit Function
If nMin >= nMax Then Exit Function
Randomize
RndptINarray = Int((nMax – nMin + 1) * Rnd + nMin)
End Function

Function RndptRange(arrMinMax)
Dim nMax, nMin

nMax= arrMinMax(1)
nMin= arrMinMax(0)

RndptRange = Null
If Not IsNumeric(nMin) Then Exit Function
If Not IsNumeric(nMax) Then Exit Function
If nMin >= nMax Then Exit Function
Randomize
RndptRange = Int((nMax – nMin + 1) * Rnd + nMin)
End Function

Function RndDbl(arrMinMax)
Dim nMax, nMin

nMax= arrMinMax(1)
nMin= arrMinMax(0)

RndDbl = Null
If Not IsNumeric(nMin) Then Exit Function
If Not IsNumeric(nMax) Then Exit Function
If nMin >= nMax Then Exit Function
Randomize
RndDbl = (nMax – nMin + 1) * Rnd + nMin
End Function

Function FindCenter (arrpts)

Dim i, Objpts(), arrBBox, arrCntrPt, j

For i=0 To Ubound(arrpts)
ReDim Preserve Objpts(i)
Objpts(i)= Rhino.AddPoint (arrpts(i))
Next

arrBBox = Rhino.BoundingBox(Objpts)
arrCntrPt = array((((arrBBox(2)(0)) + (arrBBox(0)(0))) / 2), (((arrBBox(2)(1)) + (arrBBox(0)(1))) / 2), (((arrBBox(0)(2)) + (arrBBox(4)(2))) / 2))

FindCenter = arrCntrPt

For j = 0 To Ubound(objpts)
Rhino.DeleteObject objpts(j)
Next

End Function
Function PurgeLosers (arrpts, arrLoserID)
Dim i

For i=0 To Ubound (arrLoserID)
arrpts(arrLoserID(i)) = Null
Next
PurgeLosers = arrpts
End Function