Option Explicit
'Script written by Luis Gil
' www.legil.org

''reads a .txt file from qhull (qdelaunay i format) and creates the delaunay regions
''script first asks for the orginal .txt file containing point coordinates exported for qhull
''then for the .txt file exported from qhull

''based on the voronoi import script by Stylianos Dritsas, www.dritsas.net

Call Delaunay

Sub Delaunay
  
  Dim arrVertPoints, arrDeReg
 
Call GetVertexFile(arrVertPoints)
Call GetDelaunay(arrDeReg)
Call CreateRegions(arrVertPoints, arrDeReg)

End Sub

  Function GetVertexFile(arrNew)
    
  Dim filename : filename = Rhino.openfilename( "Open File Containing Vertex Locations", "QHull Files (*.*)|*.*||" )
  'If( IsNull( filename ) ) Then Exit Function
     
  Dim filesystem
  Set filesystem = CreateObject( "Scripting.FileSystemObject" )
  'If( Not filesystem.fileexists( filename ) ) Then Exit Function
  
  Dim textstream  
  Set textstream = filesystem.opentextfile( filename )
  
  Call textstream.skipline()
  
  'get header info
  Dim header
  header = parse(textstream.readline())

  'set number of vertices and facets from document
  Dim intVertCount
  intVertCount = header(0)
  
  'store vertex positions for facet creation
  ReDim arrVerts(intVertCount - 1)
  
  For i = LBound(arrVerts) To UBound(arrVerts)
    
    arrVerts(i) = parse(textstream.readline())

  Next
  
  arrNew = arrVerts
  
  End Function
  
  Function GetDelaunay(arrNew2)
    
  Dim filename2
  filename2 = Rhino.openfilename( "Open File Containing Delaunay Regions", "QHull Files (*.*)|*.*||" )
  'If( IsNull( filename ) ) Then Exit Function
     
  Dim filesystem2
  Set filesystem2 = CreateObject( "Scripting.FileSystemObject" )
  'If( Not filesystem.fileexists( filename ) ) Then Exit Function
    
  Dim textstream2
  Set textstream2 = filesystem2.opentextfile( filename2 )
  
  'get header info
  Dim delaunayHeader
  delaunayHeader = parse(textstream2.readline())

  'set number of regions 
  Dim intRegionCount
  intRegionCount = delaunayHeader(0)
  
  'store vertex positions for facet creation
  ReDim arrRegions(intRegionCount - 1)
  
  For i = LBound(arrRegions) To UBound(arrRegions)
    
    arrRegions(i) = parse(textstream2.readline())

  Next
  
  arrNew2 = arrRegions
  
  End Function
  
  Function CreateRegions(arrVerts, arrDef)
    
    Dim arrSrfId, arrDefPoints
    Dim strSolid
    
    Call Rhino.EnableRedraw(False)
    Dim q
    For q = LBound(arrDef) To UBound(arrDef)
      Dim arrPointId
      arrPointId = arrDef(q)
      
      ReDim arrDefPoints(UBound(arrPointID))
      
      Dim t
      For t = LBound(arrPointId) To UBound(arrPointId)
        
        arrDefPoints(t) = arrVerts(arrPointId(t))
        
      Next
      
      ReDim arrSrfId(3)
      
      arrSrfId(0) = Rhino.AddSrfPt(Array(arrDefPoints(0), arrDefPoints(1), arrDefPoints(2)))
      arrSrfId(1) = Rhino.AddSrfPt(Array(arrDefPoints(0), arrDefPoints(1), arrDefPoints(3)))
      arrSrfId(2) = Rhino.AddSrfPt(Array(arrDefPoints(0), arrDefPoints(2), arrDefPoints(3)))
      arrSrfId(3) = Rhino.AddSrfPt(Array(arrDefPoints(1), arrDefPoints(2), arrDefPoints(3)))
      
      Call Rhino.JoinSurfaces(arrSrfId, True)
      
    Next
    Call Rhino.EnableRedraw(True)
    
  End Function
  
  Function parse( text )
  
    Dim result
    result = Rhino.strtok( text )
  
    Dim index
    For index = LBound( result ) To UBound( result )
  
      result( index ) = Eval( result( index ) )
  
    Next
  
    parse = result
  
  End Function