Sina Mesdaghi,Paola Marquez

From KokkugiaWiki

final project

Double Interactive Surface

Option Explicit
'created by sina.mesdaghi and paola marquez
'july 25, 2008
'10 test

Call Main()
Sub Main()
  Dim i,j, arrattpts, dblDist,    dblColor,dblColor1,dblColor2,dblRange,strattpt,arrattpt,dbltestDist
  Dim arrBtmTopC, arrBtmBtmC, arrBtmTop0, arrBtmBtm0, arrBtmMid0, arrBtmTop1, arrBtmBtm1, arrBtmMid1, arrBtmTop2, arrBtmBtm2, arrBtmMid2, arrBtmTop3, arrBtmBtm3, arrBtmMid3
  Dim arrTopTopC, arrTopBtmC, arrTopTop0, arrTopBtm0, arrTopMid0, arrTopTop1, arrTopBtm1, arrTopMid1, arrTopTop2, arrTopBtm2, arrTopMid2, arrTopTop3, arrTopBtm3, arrTopMid3
  Dim strBtmCrv0, strBtmCrv1, strBtmCrv2, strBtmCrv3, strTopCrv0, strTopCrv1, strTopCrv2, strTopCrv3
  Dim strBtmLft, arrBtmLft, strTopLft, arrTopLft
  
  arrattpts = Rhino.GetObjects ("select your attractor point yare")
  For j = 0 To 25
    For i = 0 To 25
      ReDim Preserve arrPt(i)
      arrPt(i) = Array(i,j,0)
      If j Mod 2 = 0 And i Mod 2 = 0 And j>0 And i>0 Then
      dblRange = 10
      dbldist = dblRange
        For Each strattpt In arrattpts
          arrattpt = Rhino.pointcoordinates (strattpt)
          dbltestDist = Rhino.distance (Array(i-0.5,j-0.5,0),arrattpt)
          If dbltestDist < dblRange Then
            If dbltestdist < dblDist Then
              dbldist = dbltestDist
            End If
          End If
          Next
     
        If dblDist > 5 Then dblDist = 5
        arrBtmTopC = Array(i,j,dblDist)
        arrBtmBtmC = Array(i,j,-5)
        
        arrBtmTop0 = Array(i+1,j+1,dblDist)
        arrBtmMid0 = Array(i+1,j+1,0)
        arrBtmBtm0 = Array(i+1,j+1,-5)

        arrBtmTop1 = Array(i-1,j+1,dblDist)
        arrBtmMid1 = Array(i-1,j+1,0)
        arrBtmBtm1 = Array(i-1,j+1,-5)
        
        arrBtmTop2 = Array(i-1,j-1,dblDist)
        arrBtmMid2 = Array(i-1,j-1,0)
        arrBtmBtm2 = Array(i-1,j-1,-5)
        
        arrBtmTop3 = Array(i+1,j-1,dblDist)
        arrBtmMid3 = Array(i+1,j-1,0)
        arrBtmBtm3 = Array(i+1,j-1,-5)
        
        
        arrTopTopC = Array(i,j,15)
        arrTopBtmC = Array(i,j,(5-dblDist)+5)
        
        arrTopTop0 = Array(i+1,j+1,15)
        arrTopMid0 = Array(i+1,j+1,10)
        arrTopBtm0 = Array(i+1,j+1,(5-dblDist)+5)

        arrTopTop1 = Array(i-1,j+1,15)
        arrTopMid1 = Array(i-1,j+1,10)
        arrTopBtm1 = Array(i-1,j+1,(5-dblDist)+5)
        
        arrTopTop2 = Array(i-1,j-1,15)
        arrTopMid2 = Array(i-1,j-1,10)
        arrTopBtm2 = Array(i-1,j-1,(5-dblDist)+5)
        
        arrTopTop3 = Array(i+1,j-1,15)
        arrTopMid3 = Array(i+1,j-1,10)
        arrTopBtm3 = Array(i+1,j-1,(5-dblDist)+5)
        
        
        strBtmCrv0 = Rhino.addcurve (Array(arrBtmTopC, arrBtmTop0, arrBtmMid0, arrBtmBtm0, arrBtmBtmC))
        strBtmCrv1 = Rhino.addcurve (Array(arrBtmTopC, arrBtmTop1, arrBtmMid1, arrBtmBtm1, arrBtmBtmC))
        strBtmCrv2 = Rhino.addcurve (Array(arrBtmTopC, arrBtmTop2, arrBtmMid2, arrBtmBtm2, arrBtmBtmC))
        strBtmCrv3 = Rhino.addcurve (Array(arrBtmTopC, arrBtmTop3, arrBtmMid3, arrBtmBtm3, arrBtmBtmC))
        
        strTopCrv0 = Rhino.addcurve (Array(arrTopTopC, arrTopTop0, arrTopMid0, arrTopBtm0, arrTopBtmC))
        strTopCrv1 = Rhino.addcurve (Array(arrTopTopC, arrTopTop1, arrTopMid1, arrTopBtm1, arrTopBtmC))
        strTopCrv2 = Rhino.addcurve (Array(arrTopTopC, arrTopTop2, arrTopMid2, arrTopBtm2, arrTopBtmC))
        strTopCrv3 = Rhino.addcurve (Array(arrTopTopC, arrTopTop3, arrTopMid3, arrTopBtm3, arrTopBtmC))
        
        arrBtmLft = Rhino.AddLoftSrf (Array(strBtmCrv0,strBtmCrv1,strBtmCrv2,strBtmCrv3,strBtmCrv0),,,4)
        arrTopLft = Rhino.AddLoftSrf (Array(strTopCrv0,strTopCrv1,strTopCrv2,strTopCrv3,strTopCrv0),,,4)
        
        dblColor = (255-dblDist*51)
        dblColor1 = 51
        dblColor2 = 51
        If dblColor < 1 Then dblColor = 1
          For Each strBtmLft In arrBtmLft
            Call Rhino.ObjectColor (strBtmLft,RGB(dblColor,dblColor1,dblColor2))
          Next
          For Each strTopLft In arrTopLft
           Call Rhino.ObjectColor (strTopLft,RGB(dblColor,dblColor1,dblColor2))
          Next
        End If
    Next
  Next
End Sub