Sub call_cellAutom


'Rhino.getpoints ("please select 5 x 5 points:",

'Rhino.GetPoints (vbTrue , , "please select 5 x 5 points:" ,, 25)


  Dim arrPts1  (9)
  Dim arrPts   (6)
  
  For intI = 0 To UBound(arrPts)
    For intK = 0 To UBound(arrPts1)
  
       arrPts1(intK) = Array (intI, intK, 0)
  
    Next
  
    arrPts(intI) = arrPts1
    
  Next
  
  arrObjects = arrPts

  For intI = 0 To UBound(arrPts)
      For intK = 0 To UBound(arrPts(intI))
  
        arrPt1 = arrPts(intI)(intK)
        arrObjects(intI)(intK) = Rhino.addpoint (arrPt1)

      Next
  Next
  
  
  For intI = 0 To 100
  arrObjects = cellAutom1 (arrObjects)
  Next
  
  
End Sub




Function cellAutom1 (arrPointObjects)


'swithes

'--------------------------------------------------------------------------------------------------
  bCASEDblClosed = vbFalse ' open edge surface topology
  bCASEDblClosed = vbTrue  ' double closed surface topology
'--------------------------------------------------------------------------------------------------

  aObPts = arrPointObjects
  
  intIMax = UBound(aObPts)
  intKMax = UBound(aObPts(0))
  
  arrNeighborCnt = arrPointObjects

'1 count neighbors for each point.

  
    For intI = 0 To UBound(aObPts)
    For intK = 0 To UBound(aObPts(intI))
  
          aINeighb = Array (intI-1, intI, intI+1)
          aKNeighb = Array (intK-1, intK, intK+1)
  

'neighbor count start
'--------------------------------------------------------------------------------------------------
          arrNeighborCnt(intI)(intK) = 0
  
  
          For intL = 0 To 2
            For intM = 0 To 2
          
            intI2 = aINeighb(intL)
            intK2 = aKNeighb(intM)
            
            If Not((intI2 = intI) And (intK2 = intK)) Then
              
  Rhino.print "(intI "&CStr(intI)&") (intK "&CStr(intK)&") (intI2 "&CStr(intI2)&") (intK2 "&CStr(intK2)&")"
  
  bCHKN = vbTrue


'border control:

  If bCASEDblClosed Then
'CASE: double closed surface topology
'--------------------------------------------------------------------------------------------------
            If intI2 < 0 Then intI2 = intIMax
            If intK2 < 0 Then intK2 = intKMax
            If intI2 > intIMax Then intI2 = 0
            If intK2 > intKMax Then intK2 = 0
'--------------------------------------------------------------------------------------------------
              Else
              
'CASE: double open
'--------------------------------------------------------------------------------------------------
            If intI2 < 0 Then bCHKN = vbFalse
            If intK2 < 0 Then bCHKN = vbFalse
            If intI2 > intIMax Then bCHKN = vbFalse
            If intK2 > intKMax Then bCHKN = vbFalse
'--------------------------------------------------------------------------------------------------
  End If
              
            If Rhino.IsObject (aObPts(intI2)(intK2)) And bCHKN Then 
            
                arrNeighborCnt(intI)(intK) = arrNeighborCnt(intI)(intK) + 1
            
            End If
            End If
            
          
            Next
          Next

'--------------------------------------------------------------------------------------------------

        Rhino.print "pt("&CStr(intI)&")("&CStr(intK)&") has neighbors("&CStr(arrNeighborCnt(intI)(intK))&")"

' more than 3: dies
  
  If Not (Rhino.IsObject(aObPts(intI2)(intK2))) And arrNeighborCnt(intI)(intK) = 2 Then

' exactly 2 and point dead: make
  
  arrPtCoordinate = Array(intI,intK,0)
  
  aObPts(intI2)(intK2) = Rhino.addpoint (arrPtCoordinate)
    
  End If
  
  If (Rhino.IsObject(aObPts(intI2)(intK2))) And arrNeighborCnt(intI)(intK) > 3 Then

  
  Rhino.deleteobject CStr(aObPts(intI2)(intK2))
  aObPts(intI2)(intK2) = "DEAD"
    
  End If



      Next

  Next
  

cellAutom1 = aObPts
  
  
  
End Function