Option Explicit
‘Script written by Mark Bearak
‘Script version Tuesday, September 18, 2007 1:26:12 PM
Call Main()
Sub Main()
Dim arrStrAttractors : arrStrAttractors = Rhino.GetObjects (“”select the attractors”, 1)
Dim intXMax : intXMax = Rhino.GetInteger (“how many in x?”, 30)
Dim intYMax : intYMax = Rhino.GetInteger (“how many in y?”, 30)
Dim d : d = Rhino.GetInteger (“max distance of falloff?”, 15)
Dim Color : Color = 255
Dim c : c = Color/d
ReDim arrAttractors(UBound(arrStrAttractors))
Dim strAttractor, k
k=0
For Each strAttractor In arrStrAttractors
arrAttractors(k) = Rhino.pointcoordinates (strAttractor)
k=k+1
Next
Dim i, j, l, v
For i=0 To intXMax
For j=0 To intYmax
Rhino.EnableRedraw (False)
If i Mod 2 = 0 Then
l=j+.57735
Else
l=j
End If
Dim arrAttractor
Dim dblDistance : dblDistance = d
v=20/dblDistance
Dim arrCenter : arrCenter = Array(i,l,0)
For Each arrAttractor In arrAttractors
Dim testDistance : testDistance = Rhino.distance (arrCenter, arrAttractor)
If testDistance < dblDistance Then
dblDistance = testDistance
End If
Next
Call Rhino.AddPoint (array(i,l,0))
Dim arrPoint1 : arrPoint1 = Array(i-.015*dblDistance*v,l+.025980762113533729*dblDistance*v,0)
Dim arrPoint2 : arrPoint2 = Array(i+.015*dblDistance*v,l+.025980762113533729*dblDistance*v,0)
Dim arrPoint3 : arrPoint3 = Array(i+.03*dblDistance*v,l,0)
Dim arrPoint4 : arrPoint4 = Array(i+.015*dblDistance*v,l-.025980762113533729*dblDistance*v,0)
Dim arrPoint5 : arrPoint5 = Array(i-.015*dblDistance*v,l-.025980762113533729*dblDistance*v,0)
Dim arrPoint6 : arrPoint6 = Array(i-.03*dblDistance*v,l,0)
Dim arrPoint1a : arrPoint1a = Array(i-.015*dblDistance*v,l+.025980762113533729*dblDistance*v,1)
Dim arrPoint2a : arrPoint2a = Array(i+.015*dblDistance*v,l+.025980762113533729*dblDistance*v,1)
Dim arrPoint3a : arrPoint3a = Array(i+.03*dblDistance*v,l,1)
Dim arrPoint4a : arrPoint4a = Array(i+.015*dblDistance*v,l-.025980762113533729*dblDistance*v,1)
Dim arrPoint5a : arrPoint5a = Array(i-.015*dblDistance*v,l-.025980762113533729*dblDistance*v,1)
Dim arrPoint6a : arrPoint6a = Array(i-.03*dblDistance*v,l,1)
Dim arrPoint7 : arrPoint7 = Array(i,l,v*dblDistance*.2)
ReDim arrObject(5)
arrObject(0) = Rhino.AddLine (arrPoint1, arrPoint2)
arrObject(1) = Rhino.AddLine (arrPoint2, arrPoint3)
arrObject(2) = Rhino.AddLine (arrPoint3, arrPoint4)
arrObject(3) = Rhino.AddLine (arrPoint4, arrPoint5)
arrObject(4) = Rhino.AddLine (arrPoint5, arrPoint6)
arrObject(5) = Rhino.AddLine (arrPoint6, arrPoint1)
ReDim arrCanopy(5)
arrCanopy(0) = Rhino.AddCurve (array(arrPoint1, arrPoint1a, arrPoint7))
arrCanopy(1) = Rhino.AddCurve (array(arrPoint2, arrPoint2a, arrPoint7))
arrCanopy(2) = Rhino.AddCurve (array(arrPoint3, arrPoint3a, arrPoint7))
arrCanopy(3) = Rhino.AddCurve (array(arrPoint4, arrPoint4a, arrPoint7))
arrCanopy(4) = Rhino.AddCurve (array(arrPoint5, arrPoint5a, arrPoint7))
arrCanopy(5) = Rhino.AddCurve (array(arrPoint6, arrPoint6a, arrPoint7))
Dim arrLoftSurface : arrLoftSurface = Rhino.AddLoftSrf (Array(arrCanopy(0),arrCanopy(1),arrCanopy(2),arrCanopy(3),arrCanopy(4),arrCanopy(5),arrCanopy(0)),,,3)
Call Rhino.DeleteObjects (arrCanopy)
If IsArray(arrObject) Then
Dim strSrf : strSrf = Rhino.AddPlanarSrf (arrObject)
Call Rhino.DeleteObjects (arrObject)
End If
Dim lngColor : lngColor = Color -(dblDistance*c)
If lngColor < 0 Then
lngColor = 0
End If
Dim arrColorR : arrColorR = (127-(fix(dblDistance*(127/c))))
Dim arrColorB : arrColorB = (191+(fix(dblDistance*(64/c))))
Call Rhino.objectColor (strSrf, rgb(arrColorR,255,arrColorB))
Call Rhino.objectColor (arrLoftSurface, rgb(arrColorR,255,arrColorB))
j=j+.1547
Next
Next
Rhino.DeleteObjects (arrStrAttractors)
rhino.EnableRedraw (True)
End Sub
