13 May 2009

Multiple points attractors 01

First attempt in a multiple point attractors rhinoscripts. I started from a code founded at Mark Bearak's Blog, then i adapted to my case. This script (I know, it's very simple ) :

-plots a grid of points choosing x and y values
-add circles with a radius defined by the distances from center of circle and point attractor
-draw a loft surface between first array of circles at x,y,z world plane and second array of circles at x,y,z world shifted of the same amount of the circles radius 
-add planar surface to the second array of circles in order to create a cap closed surface

'Option Explicit
'Script written by Mark Bearak
'Script version Tuesday, September 18, 2007 1:26:12 PM
  'adapted by Davide del Giudice
'             http://madeincalifornia.blogspot.com/

Call Main()
Sub Main()
Dim arrStrAttractors : arrStrAttractors = Rhino.GetObjects ("select the attractors", 1)
Dim intXMax : intXMax = Rhino.GetInteger ("how many in x?", 50)
Dim intYMax : intYMax = Rhino.GetInteger ("how many in y?",50)
Dim d : d = Rhino.GetInteger ("max distance of falloff?", 5)
Dim Color : Color = 255
Dim c : c = Color/d
ReDim arrAttractors(UBound(arrStrAttractors))
Dim strAttractor, k
For Each strAttractor In arrStrAttractors
arrAttractors(k)    = Rhino.pointcoordinates (strAttractor)

Dim i, j, l, v
For i=0 To intXMax
For j=0 To intYmax
'Rhino.EnableRedraw (False)
If i Mod 2 = 0 Then
End If
Dim arrAttractor
Dim dblDistance  : dblDistance  = d
Dim arrCenter    : arrCenter    = Array(i,l,0)
For Each arrAttractor In arrAttractors
Dim testDistance : testDistance = Rhino.distance (arrCenter, arrAttractor)
If testDistance <>
dblDistance = testDistance
End If
Call Rhino.AddPoint (array(i,l,0))
arrPoints= Rhino.AddPoint (array(i,l,0))
Dim arrPlane,strpath,arrplane2,arrplane3,arrplane4,strObjects, strObjects2

arrplane2=Rhino.WorldXYPlane 'Rhino.PlaneFromPoints (array(i,i,0),array(i-1,i-1,0), array(i+1,i+1,0))
arrplane= Rhino.MovePlane (arrPlane2, array(i,l,0))
arrplane4= Rhino.MovePlane (arrPlane3, array(i,l,dblDistance))
strObjects= rhino.AddCircle (arrPlane, dblDistance*0.1)
strObjects2= rhino.AddCircle (arrPlane4, dblDistance*0.1)
strPath = Rhino.AddLine(Array(i,l,0), Array(i,l,dblDistance))
Call rhino.addloftsrf( array (strObjects,strObjects2))
Call Rhino.AddPlanarSrf (array(strObjects2))
'Rhino.ExtrudeCurve arrObjects, strPath
'Call Rhino.DeleteObjects (arrObject)
Dim lngColor : lngColor = Color -(dblDistance*c)
If lngColor <>
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
Rhino.DeleteObjects (arrStrAttractors)
'rhino.EnableRedraw (True)
End Sub

0 commenti: