Option Explicit
‘Script written by <Marina Cisneros and Olivera Grk>
‘Script copyrighted by <insert company name>
‘Script version Monday, October 19, 2009 1:51:37 PM
Call Main()
Sub Main()
Dim arGrowPTs : arGrowPts = rhino.GetPointCoordinates (“Select Grow Points”)
Dim arVolumes : arVolumes = rhino.getobjects (“SelVolumes”,16)
Dim time
time=0
For i=0 To 5
Dim arVolPts : arVolPts = f_GetPointArrayFromVolumes (arVolumes)
Dim arVolCntrs : arVolCntrs = f_GetVolumeCentroids (arVolPts)
Dim splitThresh : splitThresh = 10
Dim i
arVolPts = f_Grow (arVolPts,arGrowPTs,time)
‘arVolPts = f_SubDivide (arVolPts)
Call f_DrawResultVolumes (arVolumes,arVolPts)
time=time+2
Next
End Sub
Function f_Grow (arVolPts,arGrowPTs,time)
Dim i,j,k,w
Dim vect
Dim movpts : movpts = arVolPts
For i=0 To ubound (movpts)
For j=0 To ubound(movpts(i))
For k=0 To UBound (movpts(i)(j))
vect = FindGrowVect (movpts(i)(j)(k),arGrowPTs,time)
movpts(i)(j)(k) = rhino.PointAdd (movpts(i)(j)(k),vect)
Next
Next
Next
f_Grow = movpts
End Function
Function f_SubdividePolygons (polygons)
Dim i,j,k
Dim centroid
Dim intVolume()
ReDim intVolume(ubound(polygons))
Dim arrSurf(), newvolumes(),newcapvolumes()
Dim srfext, srfint
For i=0 To ubound(polygons)
centroid= Rhino.SurfaceVolumeCentroid (polygons(i))
intVolume(i)= Rhino.ScaleObject (polygons(i), centroid(0), array(0.33,0.33,0.33),True)
srfext= rhino.ExplodePolysurfaces (polygons(i))
srfint= rhino.ExplodePolysurfaces (intVolume(i))
For k=0 To ubound(srfext)
srfext(k)= Rhino.DuplicateSurfaceBorder(srfext(k))
srfint(k)= Rhino.DuplicateSurfaceBorder (srfint(k))
Next
For j=0 To ubound (srfext)
ReDim arrSurf(ubound(srfext))
ReDim Preserve newvolumes (ubound(srfext))
arrSurf(j)= array(srfext(j)(0),srfint(j)(0))
newvolumes(j)= Rhino.AddLoftSrf (arrSurf(j))
rhino.DeleteObjects(srfext(j))
rhino.DeleteObjects(srfint(j))
Next
For j=0 To ubound (srfext)
ReDim Preserve newcapvolumes(ubound(srfext))
newcapvolumes(j)= Rhino.CapPlanarHoles (newvolumes(j)(0))
Next
f_SubdividePolygons= newvolumes
Next
End Function
Function FindGrowVect (pt,arGrowPts,time)
Dim i
Dim length, scale,timescale
Dim vect: vect= array(0,0,0)
Dim adVect
Dim vectz
For i=0 To ubound (arGrowPts)
adVect = rhino.vectorcreate (pt,arGrowPts(i))
vectz = array (0,0,(adVect(2))*.75)
length = Rhino.VectorLength (adVect)
adVect = Rhino.VectorUnitize (adVect)
scale = 100/length
adVect = rhino.VectorScale (adVect,scale)
vect = rhino.VectorAdd (adVect,vect)
vect = rhino.VectorAdd (vectz, vect)
timescale= (1-(time/10))
vect = rhino.VectorScale (vect,timescale)
Next
FindGrowVect = vect
End Function
‘tool Functions
Function f_GetPointArrayFromVolumes (arVolumes)
f_GetPointArrayFromVolumes = Null
Dim arVolPts()
ReDim arVolPts (Ubound (arVolumes))
Dim i,j
Dim explode,cellpts(),cellcurve
For i=0 To ubound (arVolPts)
explode = rhino.ExplodePolysurfaces (arVolumes(i))
ReDim cellpts (Ubound (explode))
For j=0 To Ubound (cellpts)
cellcurve = Rhino.DuplicateSurfaceBorder (explode(j))
cellpts(j) = rhino.CurvePoints (cellcurve(0))
rhino.deleteobject cellcurve(0)
Next
arVolPts (i) = cellpts
rhino.DeleteObjects explode
Next
f_GetPointArrayFromVolumes = arVolPts
End Function
Function f_GetVolumeCentroids (arVolPts)
f_GetVolumeCentroids = Null
Dim i,n,j,k
ReDim arCntroids (Ubound (arVolPts))
Dim flatpts
For i=0 To ubound (arVolPts)
flatpts = Flatten2DptArray (arVolPts(i))
flatpts = CleanOutRedundantPts (flatpts)
arCntroids(i) = FindCntrOfPts (flatpts)
Next
f_GetVolumeCentroids = arCntroids
End Function
Function Flatten2DptArray (Arpts)
Dim i,j,n
Dim newpts()
n=0
For i=0 To ubound (Arpts)
For j=0 To ubound (Arpts(i))
ReDim Preserve newpts (n)
newpts(n) = Arpts(i)(j)
n=n+1
Next
Next
Flatten2DptArray = newpts
End Function
Function CleanOutRedundantPts (arpts)
Dim i,j
Dim n : n=0
Dim trig
Dim d
Dim returnpts()
For i=0 To Ubound (arpts)
If i=0 Then
ReDim Preserve returnpts(n)
returnpts(n) = arpts(i)
n=n+1
Else
trig = False
For j=0 To ubound (returnpts)
d=rhino.Distance (arpts(i),returnpts(j))
If d < 0.1 Then
trig = True
End If
Next
If trig = False Then
ReDim Preserve returnpts(n)
returnpts(n) = arpts(i)
n=n+1
End If
End If
Next
CleanOutRedundantPts = returnpts
End Function
Function f_DrawResultVolumes (arVolumes,arVolPts)
Dim i,j,k
Dim surf()
ReDim surf(ubound(arVolPts(i)))
Dim volum()
ReDim volum(ubound(arVolpts))
For i=0 To ubound (arVolPts)
For j=0 To ubound (arVolPts(i))
arVolPts(i)(j)=Rhino.CullDuplicatePoints(arVolPts(i)(j))
surf(j) = Rhino.AddSrfPt (arVolPts(i)(j))
Next
volum(i) = Rhino.JoinSurfaces (surf)
rhino.deleteobjects surf
Next
arVolumes= volum
End Function
Function FindCntrOfPts (arrPts)
Dim Vects(),finvect
ReDim Vects (Ubound (arrPts))
Dim i
For i=0 To ubound(arrPts)
Vects(i) = rhino.vectorCreate (arrPts(i),array(0,0,0))
Next
finvect = rhino.vectorCreate (array(0,0,0),array(0,0,0))
For i=0 To ubound (Vects)
finvect= rhino.vectoradd (Vects(i),finvect)
Next
Finvect=Rhino.vectorScale (finvect,1/i)
FindCntrOfPts = Finvect
End Function