Expansion

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