Monday, February 06, 2006

RH3_VoronoiScape (inProgress_v.060206)

Option Explicit
'voronoi core written by david rutten
'script continued by thomas wingate for the use at the icehotel
'transformed by marc fornes / theverymany (060206) for the use for the Pau landscape

Sub VoronoiTiles()

Dim ptCloud, BBox, tileZ
Dim arrPt, i
Dim crv, crvs, srf, extrCrv, tile, S, E

ptCloud = Rhino.GetObject("Select a pointcloud...", 2, vbTrue, vbTrue)
If IsNull(ptCloud) Then Exit Sub

BBox = Rhino.BoundingBox(ptCloud) 'there seems to be a discrepancy in the bbdimension compared to the rhino command
arrPt = Rhino.PointCloudPoints(ptCloud)
S = Array(0,0,0)

For i = 0 To UBound(arrPt)
'turn redraw off until the tile is complete
Rhino.EnableRedraw vbFalse

'draw the voronoi cell
VoronoiPolygon i, arrPt, BBox

'create a planar surface from the voronoi cell
crv = Rhino.FirstObject
crvs = Rhino.ExplodeCurves(crv, vbTrue)

Dim k: k = 0
Dim strLigne
For Each strLigne In crvs
ReDim Preserve arrPtEnd(UBound(crvs)+1)
arrPtEnd(k) = Rhino.CurveEndPoint(strLigne)
k = k+1
arrPtEnd(k) = arrPtEnd(0)
Dim strNurbs: strNurbs = Rhino.addCurve (arrPtEnd)
Rhino.objectColor strNurbs, RGB(0,150,255)

Rhino.EnableRedraw vbTrue


End Sub

'this function creates a voronoi cell for agiven point in a set of points
'it should probably be optimized so that it only tests points near the samplepoint
Function VoronoiPolygon(index, datSet, BBox)
VoronoiPolygon = Null

Dim midPt, arrPt, vecDir(1)
Dim ptS(2), ptE(2)
Dim ChordLength, Border
Dim brdLines(), i, N
ReDim brdLines(UBound(datSet)-1)
ChordLength = Rhino.Distance(BBox(0), BBox(2))

arrPt = datSet(index)
N = 0
For i = 0 To UBound(datSet)
If i <> index Then
midPt = Array((datSet(i)(0) + datSet(index)(0))/2, _
(datSet(i)(1) + datSet(index)(1))/2, _
vecDir(0) = -(datSet(i)(1)-datSet(index)(1))
vecDir(1) = datSet(i)(0)-datSet(index)(0)
vecDir(0) = vecDir(0)/Rhino.Distance(datSet(i), datSet(index))*ChordLength
vecDir(1) = vecDir(1)/Rhino.Distance(datSet(i), datSet(index))*ChordLength
ptS(0) = midPt(0)+vecDir(0)
ptS(1) = midPt(1)+vecDir(1)
ptS(2) = 0
ptE(0) = midPt(0)-vecDir(0)
ptE(1) = midPt(1)-vecDir(1)
ptE(2) = 0
brdLines(N) = Rhino.AddLine(ptS, ptE)
N = N+1
End If

Border = Rhino.AddPolyline(Array(Array(BBox(0)(0)-10, BBox(0)(1)-10, 0), _
Array(BBox(1)(0)+10, BBox(1)(1)-10, 0), _
Array(BBox(2)(0)+10, BBox(2)(1)+10, 0), _
Array(BBox(3)(0)-10, BBox(3)(1)+10, 0), _
Array(BBox(0)(0)-10, BBox(0)(1)-10, 0)))

Rhino.SelectObjects brdLines
Rhino.SelectObject Border
Rhino.Command "-_CurveBoolean _DeleteInput=Yes _CombineRegions=No " & _
Rhino.Pt2Str(Array(datSet(index)(0),datSet(index)(1),datSet(index)(2))) & _
" _Enter", vbFalse

VoronoiPolygon = vbTrue
End Function