Rh3_UsualSuspect_HoneyComb (v.Old&Rusty)

Option Explicit
'------------------------------------------------------------------------------
' Subroutine: HoneyComb
' Purpose: Creates form a surface an array of normals, section and loft them.
'------------------------------------------------------------------------------
Sub HoneyComb()
Dim strObject, nLONGITUDE, nTRANSVERSAL
Dim U, V, i, j, arrParam(1), arrPoint
Dim arrParamNormal, arrNormal, Normal_Line
Dim InterpCurve
Dim strObjectLoft
Dim strInterpCurve
Dim strInterpCurveOnSurf
Dim intDeltaHeight
Dim intLoft_sectionsFrequence
Dim intLoftType
Dim arrInterpCurve
Dim indexCROSS_everyNpoint
Dim k: k = 0
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
' [ Get SURFACE object ]
strObject = Rhino.GetObject("Select surface", 8)
If IsNull(strObject) Then Exit Sub

' [ PROPERTY LIST BOX ]
' set variables
Dim arrParameters, arrResults, arrValues
' set paramters names
arrParameters = array("i: rows/sections (>1)", "j: columns/isoParms (>1)", "NORMAL: _height (<>0)", "WAVE: _crossEvery", "LOFT: _Type", "_____1 / Normal", "_____2 / Loose", "_____3 / Tight", "_____4 / Straight")
' set default values
arrValues = array("60", "10", "0.2", "3", "2", "-", "-", "-", "-")
' create "Property list box"
arrResults = Rhino.PropertyListBox(arrParameters, arrValues, "Parameters", "ZOOYORK{1117_PAU_Skin_Panels}" )
If IsArray(arrResults) Then
' NUMBER of rows/sections:
nLONGITUDE = FormatNumber(arrResults(0))
If IsNull(nLONGITUDE) Then Exit Sub
nLONGITUDE = nLONGITUDE - 1
' NUMBER of columns:
nTRANSVERSAL = FormatNumber(arrResults(1))
If IsNull(nTRANSVERSAL) Then Exit Sub
nTRANSVERSAL = nTRANSVERSAL - 1
' NORMAL: _height
intDeltaHeight = FormatNumber(arrResults(2))
If IsNull(intDeltaHeight) Then Exit Sub
intDeltaHeight = intDeltaHeight - 1
' WAVE: _crossEvery
indexCROSS_everyNpoint = FormatNumber(arrResults(3))
If IsNull (indexCROSS_everyNpoint) Then Exit Sub
indexCROSS_everyNpoint = indexCROSS_everyNpoint -1
indexCROSS_everyNpoint = indexCROSS_everyNpoint +1
' LOFT: _Type
intLoftType = FormatNumber(arrResults(4))
If IsNull(intLoftType) Or intLoftType > 4 Then Exit Sub
intLoftType = intLoftType - 1
End If
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
' GET DOMAIN OF SURFACE
U = Rhino.SurfaceDomain(strObject, 0)
V = Rhino.SurfaceDomain(strObject, 1)
If Not IsArray(U) Or Not IsArray(V) Then Exit Sub
' ---------------------------------------------------------------------------------
' FOR each rows/sections:

' ---------------------------------------------------------------------------------
For i = 0 To nLONGITUDE
arrParam(1) = V(0) + (((V(1) - V(0)) / nLONGITUDE) * i)

'For i = 0 To nLONGITUDE
'arrParam(1) = U(0) + (((U(1) - U(0)) / nLONGITUDE) * i)
' ---------------------------------------------------------------------------------
' FOR each columns/isoParms

'---------------------------------------------------------------------------------
'For j = 0 To nTRANSVERSAL
'arrParam(0) = V(0) + (((V(1) - V(0)) / nTRANSVERSAL) * j)

For j = 0 To nTRANSVERSAL
arrParam(0) = U(0) + (((U(1) - U(0)) / nTRANSVERSAL) * j)
arrPoint = Rhino.EvaluateSurface(strObject, arrParam)
'If IsArray(arrPoint) Then Rhino.AddPoint arrPoint
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ ADD NORMAL ]
arrParamNormal = Rhino.SurfaceClosestPoint(strObject, arrPoint)
arrNormal = Rhino.SurfaceNormal(strObject, arrParamNormal)
' (arrNormal(0) is point on surf & arrNromal(1) is end of Normal)

' [ SET HEIGHT ALONG NORMAL ]
' Normal as Vector
Dim arrNormal_VECTOR
arrNormal_VECTOR = array( (arrNormal(1)(0))-(arrNormal(0)(0)), _
(arrNormal(1)(1))-(arrNormal(0)(1)), _
(arrNormal(1)(2))-(arrNormal(0)(2)) )
' Normal End Pt: translate along arrNormal_VECTOR and multiply by factor
Dim arrNormal_ScaledEndPt
arrNormal_ScaledEndPt = array( (arrNormal(1)(0))+(arrNormal_VECTOR(0)*intDeltaHeight), _
(arrNormal(1)(1))+(arrNormal_VECTOR(1)*intDeltaHeight), _
(arrNormal(1)(2))+(arrNormal_VECTOR(2)*intDeltaHeight) )
' Normal addLine
'Normal_Line = Rhino.addLine (arrNormal(0), arrNormal_ScaledEndPt)
'Rhino.objectColor Normal_Line, RGB(255, 0, 255)

' Normal: keep the first as path for the extrusion
'If j=0 Then Normal_Line = Rhino.addLine (arrNormal(0), arrNormal_ScaledEndPt)
If STRIPE_FrequenceNumber Mod 2 Then
If j=0 Then Normal_Line = Rhino.AddInterpCurveEx (array(arrNormal(0), arrNormal_ScaledEndPt))
End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ COLLECT NORMAL POINTS ]
' Normal PtOnSurface:
ReDim Preserve arrNormal_PtOnSurf_Collect(nTRANSVERSAL)
arrNormal_PtOnSurf_Collect(j) = arrNormal(0)
' Normal Scaled End PT:
ReDim Preserve arrNormal_PtEnd_Collect(nTRANSVERSAL)
' special case for the EDGE
If i=0 And i=nLONGITUDE And j=0 And j=nTRANSVERSAL Then
' else keep the point on the Edge
arrNormal_PtEnd_Collect(j) = arrNormal(0)
Else
' if different from first or last Pt:
arrNormal_PtEnd_Collect(j) = arrNormal_ScaledEndPt
End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'[ EXPERIMENT ]
'Dim indexCROSS_everyNpoint: indexCROSS_everyNpoint = 2
' in order to start the count of every two, one stripe before
' catch on LONGITUDE (i) some points on the previous: it only start starting from the 2
Dim STRIPE_FrequenceNumber: STRIPE_FrequenceNumber = i+1

ReDim Preserve arrPt_WAVE(nTRANSVERSAL)
Dim strWAVE

'in order to start the count of every two, one stripe before
If STRIPE_FrequenceNumber Mod 2 Then
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
' [ GREY & PINK ]
If STRIPE_FrequenceNumber <> 1 Then
' first stripe doesn't have any previous history

'If j Mod indexCROSS_everyNpoint Then
'If j Mod indexCROSS_everyNpoint And J Mod (indexCROSS_everyNpoint+1) Then
If j Mod ((Rnd*10)+1) Then
' point on this row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect(j)
Else
' point on the previous row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect_PreviousRow(j)
End If

k = k + 1
If k = indexCROSS_everyNpoint Then k = 0

If j = nTRANSVERSAL Then
' addCurve: WAVE GREY
'strWAVE = Rhino.AddInterpCrvOnSrf (strObject,arrPt_WAVE)
strWAVE = Rhino.AddInterpCurve (arrPt_WAVE, 1)
Rhino.objectColor strWAVE, RGB(150, 150, 150)

' EXTRUDE CURVE
Rhino.ExtrudeCurve strWAVE, Normal_Line

End If

End If
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
Else
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
' [ BLACK & PURPLE]
' one point every two
'If j Mod indexCROSS_everyNpoint Then
If j Mod ((Rnd*10)+1) Then
' point on this row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect_PreviousRow(j)
Else
' point on the previous row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect(j)
End If

k = k + 1
If k = indexCROSS_everyNpoint Then k = 0

If j = nTRANSVERSAL Then
' addCurve: WAVE BLACK
'strWAVE = Rhino.AddInterpCrvOnSrf (strObject,arrPt_WAVE)
strWAVE = Rhino.AddInterpCurve (arrPt_WAVE, 1)
Rhino.objectColor strWAVE, RGB(0, 0, 0)

' EXTRUDE CURVE
Rhino.ExtrudeCurve strWAVE, Normal_Line

End If
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
End If

'keep WAVE
ReDim Preserve strWAVE_previous(nLONGITUDE)
strWAVE_previous(i) = strWAVE
' keep the collection of point of the previous row
ReDim Preserve arrNormal_PtOnSurf_Collect_PreviousRow(nTRANSVERSAL)
arrNormal_PtOnSurf_Collect_PreviousRow(j) = arrNormal_PtOnSurf_Collect(j)
'[ END EXPERIMENT ]
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------
End Sub
HoneyComb

Rh4_LorenzAttractor_v.060221

Option Explicit
Sub LorenzAttractor()

Dim MaxPuntos : MaxPuntos = 100000
Dim arrPt
Dim x,y,z
x = 1 : y = 1 : z = 1
Dim arrPtPrevious : arrPtPrevious = Array(x,y,z)
Dim h : h = 0.001
Dim nPuntos : nPuntos = 0

Do While (nPuntos < MaxPuntos)
x = x + h * dx(x,y,z)
y = y + h * dy(x,y,z)
z = z + h * dz(x,y,z)
arrPt = Array(x,y,z)
'Rhino.addPoint arrPt
Rhino.addLine arrPtPrevious, arrPt
arrPtPrevious = arrPt
nPuntos = nPuntos + 1
Loop

End Sub
LorenzAttractor

Function dx (x,y,z)
dx = 10 * ( y - x )
End Function
Function dy (x,y,z)
dy = -x * z + 28 * x - y
End Function
Function dz (x,y,z)
dz = x * y - ( 8 / 3 ) * z
End Function

Rh3_XefioRetro_Weaves [Old&Rusty]

Option Explicit
'------------------------------------------------------------------------------
' Subroutine: ArraySurfaceNormalSectionLoft
' Purpose: Creates form a surface an array of normals, section and loft them.
'------------------------------------------------------------------------------
Sub ArraySurfaceNormalSectionLoft()

Dim strObject, nLONGITUDE, nTRANSVERSAL
Dim U, V, i, j, arrParam(1), arrPoint
Dim arrParamNormal, arrNormal, Normal_Line
Dim InterpCurve
Dim strObjectLoft
Dim strInterpCurve
Dim strInterpCurveOnSurf
Dim intDeltaHeight
Dim intLoft_sectionsFrequence
Dim intLoftType
Dim arrInterpCurve

' ---------------------------------------------------------------------------------
' [ Get SURFACE object ]
strObject = Rhino.GetObject("Select surface", 8)
If IsNull(strObject) Then Exit Sub

' [ PROPERTY LIST BOX ]
' set variables
Dim arrParameters, arrResults, arrValues
' set paramters names
arrParameters = array("i: rows/sections (>1)", "j: columns/isoParms (>1)", "Normal: _height (<>0)", "Loft: _sectFrequence", "LOFT_Type", " _1 / Normal", " _2 / Loose", " _3 / Tight", " _4 / Straight")
' set default values
arrValues = array("60", "10", "0.5", "2", "2", "-", "-", "-", "-")
' create "Property list box"
arrResults = Rhino.PropertyListBox(arrParameters, arrValues, "Parameters", "ZOOYORK{1117_PAU_Skin_Panels}" )
If IsArray(arrResults) Then
' NUMBER of rows/sections:
nLONGITUDE = FormatNumber(arrResults(0))
If IsNull(nLONGITUDE) Then Exit Sub
nLONGITUDE = nLONGITUDE - 1
' NUMBER of columns:
nTRANSVERSAL = FormatNumber(arrResults(1))
If IsNull(nTRANSVERSAL) Then Exit Sub
nTRANSVERSAL = nTRANSVERSAL - 1
' NORMAL _height:
intDeltaHeight = FormatNumber(arrResults(2))
If IsNull(intDeltaHeight) Then Exit Sub
intDeltaHeight = intDeltaHeight - 1
' LOFT _Frequence:
intLoft_sectionsFrequence = FormatNumber(arrResults(3))
If intLoft_sectionsFrequence < 2 Then Exit Sub
intLoft_sectionsFrequence = intLoft_sectionsFrequence -1
intLoft_sectionsFrequence = intLoft_sectionsFrequence +1
' LOFT: _Type:
intLoftType = FormatNumber(arrResults(4))
If IsNull(intLoftType) Or intLoftType > 4 Then Exit Sub
intLoftType = intLoftType - 1
End If
' ---------------------------------------------------------------------------------



' GET DOMAIN OF SURFACE
U = Rhino.SurfaceDomain(strObject, 0)
V = Rhino.SurfaceDomain(strObject, 1)
If Not IsArray(U) Or Not IsArray(V) Then Exit Sub

' ---------------------------------------------------------------------------------
' FOR each rows/sections:
' ---------------------------------------------------------------------------------
For i = 0 To nLONGITUDE
arrParam(0) = U(0) + (((U(1) - U(0)) / nLONGITUDE) * i)

' ---------------------------------------------------------------------------------
' FOR each columns/isoParms
' ---------------------------------------------------------------------------------
For j = 0 To nTRANSVERSAL
arrParam(1) = V(0) + (((V(1) - V(0)) / nTRANSVERSAL) * j)
arrPoint = Rhino.EvaluateSurface(strObject, arrParam)
'If IsArray(arrPoint) Then Rhino.AddPoint arrPoint

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ ADD NORMAL ]
arrParamNormal = Rhino.SurfaceClosestPoint(strObject, arrPoint)
arrNormal = Rhino.SurfaceNormal(strObject, arrParamNormal)
' (arrNormal(0) is point on surf & arrNromal(1) is end of Normal)

' [ SET HEIGHT ALONG NORMAL ]
' Normal as Vector
Dim arrNormal_VECTOR
arrNormal_VECTOR = array( (arrNormal(1)(0))-(arrNormal(0)(0)), _
(arrNormal(1)(1))-(arrNormal(0)(1)), _
(arrNormal(1)(2))-(arrNormal(0)(2)) )
' Normal End Pt: translate along arrNormal_VECTOR and multiply by factor
Dim arrNormal_ScaledEndPt
arrNormal_ScaledEndPt = array( (arrNormal(1)(0))+(arrNormal_VECTOR(0)*intDeltaHeight), _
(arrNormal(1)(1))+(arrNormal_VECTOR(1)*intDeltaHeight), _
(arrNormal(1)(2))+(arrNormal_VECTOR(2)*intDeltaHeight) )
' Normal addLine
Normal_Line = Rhino.addLine (arrNormal(0), arrNormal_ScaledEndPt)
Rhino.objectColor Normal_Line, RGB(255, 0, 255)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ COLLECT NORMAL POINTS ]
' Normal PtOnSurface:
ReDim Preserve arrNormal_PtOnSurf_Collect(nTRANSVERSAL)
arrNormal_PtOnSurf_Collect(j) = arrNormal(0)
' Normal Scaled End PT:
ReDim Preserve arrNormal_PtEnd_Collect(nTRANSVERSAL)
' special case for the EDGE
If i=0 And i=nLONGITUDE And j=0 And j=nTRANSVERSAL Then
' else keep the point on the Edge
arrNormal_PtEnd_Collect(j) = arrNormal(0)
Else
' if different from first or last Pt:
arrNormal_PtEnd_Collect(j) = arrNormal_ScaledEndPt
End If
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
'[ EXPERIMENT ]
Dim indexCROSS_everyNpoint: indexCROSS_everyNpoint = 2
' in order to start the count of every two, one stripe before
' catch on LONGITUDE (i) some points on the previous: it only start starting from the 2
Dim STRIPE_FrequenceNumber: STRIPE_FrequenceNumber = i+1

ReDim Preserve arrPt_WAVE(nTRANSVERSAL)
Dim strWAVE
' WAVE UpDown is curve straight via all j points
ReDim Preserve arrPt_WAVE_UpDown(nTRANSVERSAL)
Dim strWAVE_UpDown

'in order to start the count of every two, one stripe before
If STRIPE_FrequenceNumber Mod 2 Then
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
' [ GREY & PINK ]
If STRIPE_FrequenceNumber <> 1 Then
' first stripe doesn't have any previous history

If j Mod indexCROSS_everyNpoint Then
' point on this row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect(j)
arrPt_WAVE_UpDown(j) = arrNormal_PtOnSurf_Collect(j)
Else
' point on the previous row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect_PreviousRow(j)
arrPt_WAVE_UpDown(j) = arrNormal_PtEnd_Collect(j)
End If

If j = nTRANSVERSAL Then
' addCurve: WAVE GREY
strWAVE = Rhino.AddInterpCrvOnSrf (strObject,arrPt_WAVE)
Rhino.objectColor strWAVE, RGB(150, 150, 150)
' addCurve: WAVE PINK
strWAVE_UpDown = Rhino.AddInterpCurve (arrPt_WAVE_UpDown, 3)
Rhino.objectColor strWAVE_UpDown, RGB(200, 0, 200)

' ADD LOFT SURFACE:
arrInterpCurve = array(strWAVE_previous(i-1), strWAVE_UpDown_previous(i-1), strWAVE)
strObjectLoft = Rhino.AddLoftSrf (arrInterpCurve, , ,intLoftType,1,100, False)
Rhino.SurfaceIsocurveDensity strObjectLoft, -1
Rhino.objectColor strObjectLoft, RGB(225, 225, 255)
End If

End If
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
Else
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
' [ BLACK & PURPLE]
' one point every two
If j Mod indexCROSS_everyNpoint Then
' point on this row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect_PreviousRow(j)
arrPt_WAVE_UpDown(j) = arrNormal_PtEnd_Collect(j)
Else
' point on the previous row
arrPt_WAVE(j) = arrNormal_PtOnSurf_Collect(j)
arrPt_WAVE_UpDown(j) = arrNormal_PtOnSurf_Collect(j)
End If

If j = nTRANSVERSAL Then
' addCurve: WAVE BLACK
strWAVE = Rhino.AddInterpCrvOnSrf (strObject,arrPt_WAVE)
Rhino.objectColor strWAVE, RGB(0, 0, 0)
' addCurve: WAVE PURPLE
strWAVE_UpDown = Rhino.AddInterpCurve (arrPt_WAVE_UpDown, 3)
Rhino.objectColor strWAVE_UpDown, RGB(100, 0, 100)

' ADD LOFT SURFACE:
If i>1 Then
arrInterpCurve = array(strWAVE_previous(i-1), strWAVE_UpDown_previous(i-1), strWAVE)
strObjectLoft = Rhino.AddLoftSrf (arrInterpCurve, , ,intLoftType,1,100, False)
Rhino.SurfaceIsocurveDensity strObjectLoft, -1
Rhino.objectColor strObjectLoft, RGB(0, 0, 0)
End If
End If
' ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ... ...
End If

'keep WAVE
ReDim Preserve strWAVE_previous(nLONGITUDE)
strWAVE_previous(i) = strWAVE
ReDim Preserve strWAVE_UpDown_previous(nLONGITUDE)
strWAVE_UpDown_previous(i) = strWAVE_UpDown

' keep the collection of point of the previous row
ReDim Preserve arrNormal_PtOnSurf_Collect_PreviousRow(nTRANSVERSAL)
arrNormal_PtOnSurf_Collect_PreviousRow(j) = arrNormal_PtOnSurf_Collect(j)
ReDim Preserve arrNormal_PtEnd_Collect_PreviousRow(nTRANSVERSAL)
arrNormal_PtEnd_Collect_PreviousRow(j) = arrNormal_PtEnd_Collect(j)
'[ END EXPERIMENT ]
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------

End Sub
ArraySurfaceNormalSectionLoft

Rh3_Ripples_v.05/03/00[Old&Rusty]

Obviously could be done much more optimized but you do nid to start somewhere...



Option Explicit
'------------------------------------------------------------------------------
' MARC.F/theverymany
' Subroutine: RIPPLES
' Purpose: Creates form a surface an array of normals, section and loft them.
'------------------------------------------------------------------------------

Sub RIPPLES()

Dim strObject, nRows, nColumns
Dim U, V, i, j, arrParam(1), arrPoint
Dim arrParamNormal, arrNormal, Normal, deltaHeight
Dim vector, arrNormalNew
Dim strInterpCurve, strInterpCurveOnSurf
Dim strObjectLoft

' ---------------------------------------------------------------------------------
' Get SURFACE object
strObject = Rhino.GetObject("Select surface", 8)
If IsNull(strObject) Then Exit Sub

' PROPERTY LIST BOX
' set variables
Dim arrParameters, arrResults, arrValues
' set paramters names
arrParameters = array("rows / sections (>1)", "columns / isoParms (>1)", "_deltaHeight")
' set default values
arrValues = array("10", "10", "3")
' create "Property list box"
arrResults = Rhino.PropertyListBox(arrParameters, arrValues, "Parameters", "ZOOYORK: RIPPLE_PlugIn" )
If IsArray(arrResults) Then
' NUMBER of rows/sections
nRows = FormatNumber(arrResults(0))
If IsNull(nRows) Then Exit Sub
nRows = nRows - 1
' NUMBER of columns
nColumns = FormatNumber(arrResults(1))
If IsNull(nColumns) Then Exit Sub
nColumns = nColumns - 1
' HEIGHT
deltaHeight = FormatNumber(arrResults(2))
If IsNull(deltaHeight) Then Exit Sub
End If
' ---------------------------------------------------------------------------------



' GET DOMAIN OF SURFACE
U = Rhino.SurfaceDomain(strObject, 0)
V = Rhino.SurfaceDomain(strObject, 1)
If Not IsArray(U) Or Not IsArray(V) Then Exit Sub

' ------------------------------------------------------
' FOR each rows/sections:
For i = 0 To nRows
arrParam(0) = U(0) + (((U(1) - U(0)) / nRows) * i)

' ------------------------------------------------------
' FOR each columns/isoParms
For j = 0 To nColumns
arrParam(1) = V(0) + (((V(1) - V(0)) / nColumns) * j)
arrPoint = Rhino.EvaluateSurface(strObject, arrParam)

' ADD NORMAL:
arrParamNormal = Rhino.SurfaceClosestPoint(strObject, arrPoint)
arrNormal = Rhino.SurfaceNormal(strObject, arrParamNormal)

' SET HEIGHT ALONG NORMAL:
vector = array((arrNormal(1)(0))-(arrNormal(0)(0)),_
(arrNormal(1)(1))-(arrNormal(0)(1)),_
(arrNormal(1)(2))-(arrNormal(0)(2)) )
arrNormalNew = array( (arrNormal(1)(0))+(vector(0)*deltaHeight), _
(arrNormal(1)(1))+(vector(1)*deltaHeight), _
(arrNormal(1)(2))+(vector(2)*deltaHeight) )
'Normal = Rhino.addLine (arrNormal(0), arrNormalNew)

' COLLECT NORMAL END POINT:
ReDim Preserve arrNormalEndCollection(nColumns)
' if first or last pt keep the point on the edge
If j = 0 And j = nColumns Then
arrNormalEndCollection(j) = arrNormal(0)
Else
arrNormalEndCollection(j) = arrNormalNew
End If
' COLLECT NORMAL ORIGINE POINT
ReDim Preserve arrNormalOrigineCollection(nColumns)
arrNormalOrigineCollection(j) = arrNormal(0)

Next
' ------------------------------------------------------

' COLLECT INTERPCURVE EVERY TWO FOR RIPPLING EFFECT:
ReDim Preserve arrInterpCurve(nRows)
If i Mod 2 Then
arrInterpCurve(i) = Rhino.addInterpCurve (arrNormalEndCollection)
Else
arrInterpCurve(i) = Rhino.AddInterpCrvOnSrf (strObject, arrNormalOrigineCollection)
End If

Next
' ------------------------------------------------------

' ADD LOFT SURFACE:
strObjectLoft = Rhino.AddLoftSrf (arrInterpCurve, , ,2,1,100)
Rhino.SurfaceIsocurveDensity strObjectLoft, -1
Rhino.objectColor strObjectLoft, RGB(255, 0, 255)

Rhino.deleteObjects arrInterpCurve

End Sub
RIPPLES

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
Next
arrPtEnd(k) = arrPtEnd(0)
Dim strNurbs: strNurbs = Rhino.addCurve (arrPtEnd)
Rhino.objectColor strNurbs, RGB(0,150,255)
'------------------------------------------------------

Rhino.EnableRedraw vbTrue

Next


End Sub
VoronoiTiles


'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, _
0)
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
Next

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.UnselectAllObjects
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

Rh3_Pau: "Rnd recess onto slab"

Option Explicit
'------------------------------------------------------------------------------
' Marc Fornes /// theverymany
' Subroutine: fromSurface
' 050611: Creates form a surface an array of normals & Circles from different diameters.
'------------------------------------------------------------------------------

Sub fromSurface()

Dim strObjects
Dim strObject, nLONGITUDE, nTRANSVERSAL
Dim U, V, i, j, arrParam(1)
Dim arrParamNormal, arrNormal', Normal_Line
Dim intDeltaHeight, intHeight_h02, intHeight_h03, intHeight_h04
Dim dblRadius
Dim intPercentage_Rnd
Dim h: h = 0

' ---------------------------------------------------------------------------------
' [ Get SURFACE object ]
strObjects = Rhino.GetObjects("Select surface", 8)
If IsNull(strObject) Then Exit Sub

' [ PROPERTY LIST BOX ]
' set variables
Dim arrParameters, arrResults, arrValues
' set paramters names
arrParameters = array("i: rows/sections (>1)", "j: columns/isoParms (>1)", "NORMAL: _height (<>0 & >_h03)",_
"CIRCLES: _radius", "CIRCLES: _%Rnd", "CIRCLES: _h02", "CIRCLES: _h03", "CIRCLES: _h04")
' set default values
arrValues = array("6", "6", "0.5", "0.28", "60", "0.05", "0.12", "0.15")
' create "Property list box"
arrResults = Rhino.PropertyListBox(arrParameters, arrValues, "Parameters", "/////////ZOOYORK/////////" )
If IsArray(arrResults) Then
' NUMBER of rows/sections:
nLONGITUDE = FormatNumber(arrResults(0))
If IsNull(nLONGITUDE) Then Exit Sub
nLONGITUDE = nLONGITUDE - 1
' NUMBER of columns:
nTRANSVERSAL = FormatNumber(arrResults(1))
If IsNull(nTRANSVERSAL) Then Exit Sub
nTRANSVERSAL = nTRANSVERSAL - 1
' NORMAL: _height
intDeltaHeight = FormatNumber(arrResults(2))
If IsNull(intDeltaHeight) Then Exit Sub
intDeltaHeight = intDeltaHeight - 1
' CIRCLE: _diameter
dblRadius = FormatNumber(arrResults(3))
If IsNull(dblRadius) Then Exit Sub
dblRadius = dblRadius '- 1
' CIRCLE: _%Rnd
intPercentage_Rnd = FormatNumber(arrResults(4))
If IsNull(intPercentage_Rnd) Then Exit Sub
intPercentage_Rnd = intPercentage_Rnd - 1
' NORMAL: _height_h02
intHeight_h02 = FormatNumber(arrResults(5))
If IsNull(intHeight_h02) Then Exit Sub
intHeight_h02 = intHeight_h02 - 1
' NORMAL: _height_h03
intHeight_h03 = FormatNumber(arrResults(6))
If IsNull(intHeight_h03) Then Exit Sub
intHeight_h03 = intHeight_h03 - 1
' NORMAL: _height_h04
intHeight_h04 = FormatNumber(arrResults(7))
If IsNull(intHeight_h04) Then Exit Sub
intHeight_h04 = intHeight_h04 - 1
End If
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
For Each strObject In strObjects
' ---------------------------------------------------------------------------------
' GET DOMAIN OF SURFACE
U = Rhino.SurfaceDomain(strObject, 0)
V = Rhino.SurfaceDomain(strObject, 1)
If Not IsArray(U) Or Not IsArray(V) Then Exit Sub

' ---------------------------------------------------------------------------------
' FOR each rows/sections:
' ---------------------------------------------------------------------------------
For i = 0 To nLONGITUDE
arrParam(0) = U(0) + (((U(1) - U(0)) / nLONGITUDE) * i)

' --------------------------------------------------------------------------------
' FOR each columns/isoParms
' ---------------------------------------------------------------------------------
For j = 0 To nTRANSVERSAL
arrParam(1) = V(0) + (((V(1) - V(0)) / nTRANSVERSAL) * j)

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ GRID POINT ON SURFACE ]
ReDim Preserve arrPt_onSurf(nLONGITUDE,nTRANSVERSAL)
arrPt_onSurf(i,j) = Rhino.EvaluateSurface(strObject, arrParam)
'Rhino.AddPoint arrPt_onSurf(i,j)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ ADD NORMAL ]
' (arrNormal(0) Is point On surf & arrNromal(1) Is End of Normal)
arrNormal = Rhino.SurfaceNormal(strObject, arrParam)
' Normal End Pt: FUNCTION: translate along arrNormal_VECTOR and multiply by factor
ReDim Preserve arrNormal_ScaledEndPt(nLONGITUDE,nTRANSVERSAL)
arrNormal_ScaledEndPt(i,j) = FUNCT_Normal_Height_Scale(arrNormal, intDeltaHeight)
' Normal addLine
ReDim Preserve Normal_Line(nLONGITUDE,nTRANSVERSAL)
'Normal_Line(i,j) = Rhino.addLine (arrNormal(0), arrNormal_ScaledEndPt(i,j))
'Rhino.objectColor Normal_Line(i,j), RGB(255, 0, 255)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' ---------------------------------------------------------------------------------
' [ RANDOM ]
' set: random number
Dim randomFactor: randomFactor = Rnd
' if: not on any border and: random number > random number input
If i>0 And i0 And j And randomFactor > ((100-intPercentage_Rnd)/100) Then

' [ ADD CIRCLES ] [ original ]
ReDim Preserve arrCircle(nLONGITUDE,nTRANSVERSAL)
arrCircle(i,j) = Rhino.AddCircle ( arrPt_onSurf(i,j), (dblRadius*randomFactor), arrNormal_ScaledEndPt(i,j) )
'Rhino.objectColor arrCircle(i,j), RGB((randomFactor*255), 0, (randomFactor*255))

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' { get circle starting point }
'ReDim Preserve arrCircle_startPoint(nLONGITUDE,nTRANSVERSAL)
'arrCircle_startPoint(i,j) = Rhino.CurveStartPoint(arrCircle(i,j))
'Rhino.AddPoint arrCircle_startPoint(i,j)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' [ ADD CIRCLES ] [ _h02 ]
' set origine next circle along normal
ReDim Preserve arrNormal_ScaledEndPt_h02(nLONGITUDE,nTRANSVERSAL)
arrNormal_ScaledEndPt_h02(i,j) = FUNCT_Normal_Height_Scale(arrNormal, intHeight_h02)
' next circle
ReDim Preserve arrCircle_h02(nLONGITUDE,nTRANSVERSAL)
arrCircle_h02(i,j) = Rhino.AddCircle ( arrNormal_ScaledEndPt_h02(i,j), ((dblRadius*randomFactor)-0.05), arrNormal_ScaledEndPt(i,j) )
'Rhino.objectColor arrCircle_h02(i,j), RGB((randomFactor*200), 0, (randomFactor*200))

' [ ADD CIRCLES ] [ _h03 ]
' set origine next circle along normal
ReDim Preserve arrNormal_ScaledEndPt_h03(nLONGITUDE,nTRANSVERSAL)
arrNormal_ScaledEndPt_h03(i,j) = FUNCT_Normal_Height_Scale(arrNormal, intHeight_h03)
' next circle
ReDim Preserve arrCircle_h03(nLONGITUDE,nTRANSVERSAL)
arrCircle_h03(i,j) = Rhino.AddCircle ( arrNormal_ScaledEndPt_h03(i,j), ((dblRadius*randomFactor)-0.05), arrNormal_ScaledEndPt(i,j) )
'Rhino.objectColor arrCircle_h03(i,j), RGB((randomFactor*150), 0, (randomFactor*150))

' [ ADD CIRCLES ] [ _h04 ]
' set origine next circle along normal
ReDim Preserve arrNormal_ScaledEndPt_h04(nLONGITUDE,nTRANSVERSAL)
arrNormal_ScaledEndPt_h04(i,j) = FUNCT_Normal_Height_Scale(arrNormal, intHeight_h04)
' next circle
ReDim arrCircle_h04_toBeArrayOneDimension(0):
arrCircle_h04_toBeArrayOneDimension(0) = Rhino.AddCircle (arrNormal_ScaledEndPt_h04(i,j), ((dblRadius*randomFactor)-0.1), arrNormal_ScaledEndPt(i,j) )
ReDim Preserve arrCircle_h04(nLONGITUDE,nTRANSVERSAL)
'arrCircle_h04(i,j) = Rhino.AddCircle ( arrNormal_ScaledEndPt_h04(i,j), ((dblRadius*randomFactor)-0.1), arrNormal_ScaledEndPt(i,j) )
arrCircle_h04(i,j) = arrCircle_h04_toBeArrayOneDimension(0)
'Rhino.objectColor arrCircle_h04(i,j), RGB((randomFactor*150), 0, (randomFactor*150))


' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ ADD LOFT ]
ReDim Preserve arrLoft(nLONGITUDE,nTRANSVERSAL)
arrLoft(i,j) = Rhino.AddLoftSrf ( array(arrCircle(i,j), arrCircle_h02(i,j), arrCircle_h03(i,j), arrCircle_h04(i,j)), , ,2,1,10, False)
Rhino.SurfaceIsocurveDensity arrLoft(i,j), -1
'Rhino.objectColor arrLoft(i,j), RGB(0, 0, 0)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' [ ADD CAP ] { planar surf }
ReDim Preserve arrCap(nLONGITUDE,nTRANSVERSAL)
arrCap(i,j) = Rhino.AddPlanarSrf (arrCircle_h04_toBeArrayOneDimension)
Rhino.SurfaceIsocurveDensity arrCap(i,j), -1
'Rhino.objectColor arrCap(i,j), RGB(0, 0, 0)
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' delete cirlces
Rhino.deleteObjects array(arrCircle(i,j), arrCircle_h02(i,j), arrCircle_h03(i,j), arrCircle_h04(i,j))
Rhino.deleteObjects arrCircle_h04_toBeArrayOneDimension
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

End If
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------

h = h + 1
' ---------------------------------------------------------------------------------
Next
' ---------------------------------------------------------------------------------

' ---------------------------------------------------------------------------------
' ---------------------------------------------------------------------------------
End Sub

fromSurface

Function FUNCT_Normal_Height_Scale (point_A, factor)
' Normal as Vector
Dim VECTOR
VECTOR = array( (point_A(1)(0))-(point_A(0)(0)), _
(point_A(1)(1))-(point_A(0)(1)), _
(point_A(1)(2))-(point_A(0)(2)) )
' Normal End Pt: translate along arrNormal_VECTOR and multiply by factor
' = origine point + ( NormalVector * height)
FUNCT_Normal_Height_Scale = array( (point_A(1)(0))+(VECTOR(0)*factor), _
(point_A(1)(1))+(VECTOR(1)*factor), _
(point_A(1)(2))+(VECTOR(2)*factor) )
End Function

Function FUNCT_Height_Scale (point_A, point_B, factor)
FUNCT_Height_Scale = array( (point_A(0))+(point_B(0)*factor), _
(point_A(1))+(point_B(1)*factor), _
(point_A(2))+(point_B(2)*factor) )
End Function