Tuesday, February 07, 2006

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