The expanded surface is the final release of the unfolded surface series at this time. This version generates an expanded surface which provides higher structural rigidity as well as aesthetic texture. This script includes a function to find the triangular inpoint from a series of 3 different points.
Rhino Script
Option Explicit 'Script written by <David Mans> 'Script copyrighted by <Neoarchaic Design> 'Script version Monday, May 26, 2008 1:43:26 PM Call Main() Sub Main() Dim surf surf = Rhino.GetObject("select surface", 8) If isNull(surf) Then Exit Sub Call reparameterize(surf) Dim arrItems, arrValues, arrResults arrItems = array("Colums", "Rows", "Offset", "OculiScale", "tabHeight", "cutTemplate", "surfaces", "imageScale", "imageOculi") arrValues = array(10, 10, 1, 0.4, 1, True, True, False, True) arrResults = Rhino.PropertyListBox(arrItems, arrValues,, "Volume Parameters") Dim scale, oculi If CBool(arrResults(7)) = True Then scale = arrImageSample(CDbl(arrResults(0)) - 1, CDbl(arrResults(1)) - 1)(6) Else scale = arrayValue(CDbl(arrResults(0)) - 1, CDbl(arrResults(1)) - 1, CDbl(arrResults(2))) End If If CBool(arrResults(8)) = True Then oculi = arrImageSample(CDbl(arrResults(0)) - 1, CDbl(arrResults(1)) - 1)(6) Else oculi = arrayValue(CDbl(arrResults(0)) - 1, CDbl(arrResults(1)) - 1, CDbl(arrResults(3))) End If Dim tri, cut(2) Call Rhino.EnableRedraw(False) tri = TriangulateSurface(surf, CDbl(arrResults(0)), CDbl(arrResults(1)), CDbl(arrResults(2))) If CBool(arrResults(6)) = True Then Call SurfaceMe(tri(0), oculi, "surfaces_out") Call SurfaceMe(tri(1), oculi, "surfaces_in") Call SurfaceMe(tri(2), oculi, "surfaces_center") End If If CBool(arrResults(5)) = True Then cut(0) = UnfoldMe(tri(0), 0, CDbl(arrResults(4)), oculi, "A") cut(1) = UnfoldMe(tri(1), cut(0) + 5, CDbl(arrResults(4)), oculi, "B") cut(2) = UnfoldMe(tri(2), cut(1) + 5, CDbl(arrResults(4)), oculi, "C") End If Call Rhino.EnableRedraw(True) End Sub Function TriangulateSurface(surface, cols, rows, offset) TriangulateSurface = Null Dim i,j Dim uDom,vDom,uStep,vStep uDom = Rhino.SurfaceDomain(surface, 0)(1): uStep = uDom / cols vDom = Rhino.SurfaceDomain(surface, 1)(1): VStep = vDom / rows ReDim uv(rows),pt(rows),ptA(rows),ptB(rows),uvSet(cols),ptSet(cols),ptSetA(cols),ptSetB(cols) 'plot point grid For i = 0 To cols Step 1 For j = 0 To rows Step 1 uv(j) = array(i * uStep, j * vStep) ptB(j) = Rhino.EvaluateSurface(surface, uv(j)) If i Mod (2) Then If j Mod (2) Then pt(j) = Rhino.EvaluateSurface(surface, uv(j)) ptA(j) = pt(j) Else pt(j) = Rhino.EvaluateSurface(surface, uv(j)) ptA(j) = pt(j) pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, uv(j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface, uv(j))), offset)) ptA(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, uv(j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface, uv(j))), -offset)) End If Else If j Mod (2) Then pt(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, uv(j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface, uv(j))), offset)) ptA(j) = Rhino.PointAdd(Rhino.EvaluateSurface(surface, uv(j)), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.SurfaceNormal(surface, uv(j))), -offset)) Else pt(j) = Rhino.EvaluateSurface(surface, uv(j)) ptA(j) = pt(j) End If End If Next uvSet(i) = uv ptSet(i) = pt ptSetA(i) = ptA ptSetB(i) = ptB Next TriangulateSurface = array(ptSet, ptSetA, ptSetB) End Function Function SurfaceMe(ptSet, scale, objLayer) SurfaceMe = Null If Rhino.IsLayer(objLayer) = False Then Call Rhino.AddLayer(objLayer, RGB(0, 0, 255)) End If Dim i,j Dim cols, rows Dim pts(1) cols = uBound(ptSet) rows = uBound(ptSet(0)) Dim srfA(),srfB(),cPt(1) ReDim srfA(rows-1),srfB(rows-1) ReDim s(cols-1) For i = 0 To cols - 1 Step 1 For j = 0 To rows - 1 Step 1 If scale(i)(j) < 0.1 Then If i Mod (2) Then If j Mod (2) Then srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j), ptSet(i)(j + 1), ptSet(i + 1)(j))) srfB(j) = Rhino.AddSrfPt(array(ptSet(i + 1)(j + 1), ptSet(i)(j + 1), ptSet(i + 1)(j))) Else srfA(j) = Rhino.AddSrfPt(array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1), ptSet(i)(j))) srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j + 1), ptSet(i + 1)(j + 1), ptSet(i)(j))) End If Else If j Mod (2) Then srfA(j) = Rhino.AddSrfPt(array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1), ptSet(i)(j))) srfB(j) = Rhino.AddSrfPt(array(ptSet(i)(j + 1), ptSet(i + 1)(j + 1), ptSet(i)(j))) Else srfA(j) = Rhino.AddSrfPt(array(ptSet(i)(j), ptSet(i)(j + 1), ptSet(i + 1)(j))) srfB(j) = Rhino.AddSrfPt(array(ptSet(i + 1)(j + 1), ptSet(i)(j + 1), ptSet(i + 1)(j))) End If End If Call Rhino.ObjectLayer(srfA(j), objLayer) Call Rhino.ObjectLayer(srfB(j), objLayer) Else If scale(i)(j) > 0.9 Then scale(i)(j) = 0.9 End If If i Mod (2) Then If j Mod (2) Then pts(0) = array(ptSet(i)(j), ptSet(i)(j + 1), ptSet(i + 1)(j)) pts(1) = array(ptSet(i + 1)(j + 1), ptSet(i)(j + 1), ptSet(i + 1)(j)) cPt(0) = incenter(pts(0)(0), pts(0)(1), pts(0)(2)) cPt(1) = incenter(pts(1)(0), pts(1)(1), pts(1)(2)) srfA(j) = innerSurf(cPt(0), pts(0), scale(i)(j)) srfB(j) = innerSurf(cPt(1), pts(1), scale(i)(j)) Else pts(0) = array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1), ptSet(i)(j)) pts(1) = array(ptSet(i)(j + 1), ptSet(i + 1)(j + 1), ptSet(i)(j)) cPt(0) = incenter(pts(0)(0), pts(0)(1), pts(0)(2)) cPt(1) = incenter(pts(1)(0), pts(1)(1), pts(1)(2)) srfA(j) = innerSurf(cPt(0), pts(0), scale(i)(j)) srfB(j) = innerSurf(cPt(1), pts(1), scale(i)(j)) End If Else If j Mod (2) Then pts(0) = array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1), ptSet(i)(j)) pts(1) = array(ptSet(i)(j + 1), ptSet(i + 1)(j + 1), ptSet(i)(j)) cPt(0) = incenter(pts(0)(0), pts(0)(1), pts(0)(2)) cPt(1) = incenter(pts(1)(0), pts(1)(1), pts(1)(2)) srfA(j) = innerSurf(cPt(0), pts(0), scale(i)(j)) srfB(j) = innerSurf(cPt(1), pts(1), scale(i)(j)) Else pts(0) = array(ptSet(i)(j), ptSet(i)(j + 1), ptSet(i + 1)(j)) pts(1) = array(ptSet(i + 1)(j + 1), ptSet(i)(j + 1), ptSet(i + 1)(j)) cPt(0) = incenter(pts(0)(0), pts(0)(1), pts(0)(2)) cPt(1) = incenter(pts(1)(0), pts(1)(1), pts(1)(2)) srfA(j) = innerSurf(cPt(0), pts(0), scale(i)(j)) srfB(j) = innerSurf(cPt(1), pts(1), scale(i)(j)) End If End If Call Rhino.ObjectLayer(srfA(j)(1), objLayer) Call Rhino.ObjectLayer(srfB(j)(1), objLayer) End If Next s(i) = array(srfA, srfB) Next SurfaceMe = s End Function Function UnfoldMe(ptSet, y, tabHeight, scale, prefix) UnfoldMe = Null If Rhino.IsLayer("cuts") = False Then Call Rhino.AddLayer("cuts", RGB(255, 0, 0)) End If If Rhino.IsLayer("scores") = False Then Call Rhino.AddLayer("scores", RGB(0, 0, 0)) End If Dim i,j,r Dim cols, rows, wrldCS cols = uBound(ptSet) rows = uBound(ptSet(0)) wrldCS = Rhino.WorldXYPlane() Dim oriPt(), angX(), ptA(), ptB(), ptC(),pts(),minX(),maxX(),mn(),mx() ReDim oriPt(rows-1), angX(rows-1), ptA(rows-1), ptB(rows-1), ptC(rows-1),minX(rows-1),maxX(rows-1),mn(cols-1),mx(cols-1),pts(cols-1) Dim angA(),angB(),angC(),disA(),disB(),disC(),s(),a(),d() ReDim angA(rows-1),angB(rows-1),angC(rows-1),disA(rows-1),disB(rows-1),disC(rows-1) ReDim a(cols-1), d(cols-1) For i = 0 To cols - 1 Step 1 For j = 0 To rows - 1 Step 1 If i Mod (2) Then If j Mod (2) Then angA(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j)), array(ptSet(i)(j), ptSet(i)(j + 1)))(0) angB(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j)), array(ptSet(i + 1)(j), ptSet(i)(j + 1)))(0) angC(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j + 1)), array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)))(0) disA(j) = Rhino.Distance(ptSet(i)(j), ptSet(i + 1)(j)) disB(j) = Rhino.Distance(ptSet(i)(j), ptSet(i)(j + 1)) disC(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)) Else angA(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j)), array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)))(0) angB(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j)), array(ptSet(i)(j), ptSet(i + 1)(j + 1)))(0) angC(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j + 1)), array(ptSet(i)(j), ptSet(i)(j + 1)))(0) disA(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i)(j)) disB(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)) disC(j) = Rhino.Distance(ptSet(i)(j), ptSet(i)(j + 1)) End If Else If j Mod (2) Then angA(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j)), array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)))(0) angB(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j)), array(ptSet(i)(j), ptSet(i + 1)(j + 1)))(0) angC(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j + 1)), array(ptSet(i)(j), ptSet(i)(j + 1)))(0) disA(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i)(j)) disB(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)) disC(j) = Rhino.Distance(ptSet(i)(j), ptSet(i)(j + 1)) Else angA(j) = Rhino.angle2(array(ptSet(i)(j), ptSet(i + 1)(j)), array(ptSet(i)(j), ptSet(i)(j + 1)))(0) angB(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j)), array(ptSet(i + 1)(j), ptSet(i)(j + 1)))(0) angC(j) = Rhino.angle2(array(ptSet(i + 1)(j), ptSet(i)(j + 1)), array(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)))(0) disA(j) = Rhino.Distance(ptSet(i)(j), ptSet(i + 1)(j)) disB(j) = Rhino.Distance(ptSet(i)(j), ptSet(i)(j + 1)) disC(j) = Rhino.Distance(ptSet(i + 1)(j), ptSet(i + 1)(j + 1)) End If End If Next a(i) = array(angA, angB, angC) d(i) = array(disA, disB, disC) Next For i = 0 To cols - 1 Step 1 r = 0 For j = 0 To rows - 1 Step 1 If j = 0 Then oriPt(j) = array(0, y, 0) angX(j) = 0 Else oriPt(j) = ptB(j - 1) If ptB(j - 1)(1) > ptC(j - 1)(1) Then angX(j) = -Rhino.Angle2(array(ptB(j - 1), Rhino.PointAdd(ptB(j - 1), wrldCS(1))), array(ptB(j - 1), ptC(j - 1)))(0) Else angX(j) = Rhino.Angle2(array(ptB(j - 1), Rhino.PointAdd(ptB(j - 1), wrldCS(1))), array(ptB(j - 1), ptC(j - 1)))(0) End If End If If i Mod (2) Then r = j + 1 Else r = j End If If r Mod (2) Then ptA(j) = Rhino.PointAdd(oriPt(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j), wrldCS(3)), d(i)(0)(j))) ptB(j) = Rhino.PointAdd(oriPt(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j) + a(i)(1)(j) + a(i)(2)(j), wrldCS(3)), d(i)(2)(j))) ptC(j) = Rhino.PointAdd(ptA(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j) + 180 - a(i)(0)(j), wrldCS(3)), d(i)(1)(j))) Else ptA(j) = Rhino.PointAdd(oriPt(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j), wrldCS(3)), d(i)(0)(j))) ptB(j) = Rhino.PointAdd(oriPt(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j) + a(i)(0)(j), wrldCS(3)), d(i)(1)(j))) ptC(j) = Rhino.PointAdd(ptA(j), Rhino.VectorScale(Rhino.VectorRotate(wrldCS(1), angX(j) + 180 - a(i)(1)(j) - a(i)(2)(j), wrldCS(3)), d(i)(2)(j))) End If minX(j) = Rhino.Min(array(ptA(j)(0), ptB(j)(0), ptC(j)(0))) maxX(j) = Rhino.Max(array(ptA(j)(0), ptB(j)(0), ptC(j)(0))) r = r + 1 Next mn(i) = Rhino.Min(minX) If mn(i) > 0 Then mn(i) = 0 Else mn(i) = abs(mn(i)) End If mx(i) = abs(Rhino.Max(maxX)) pts(i) = array(oriPt, ptA, ptB, ptC) Next Dim ptX, k,u Dim points(3),yVal(3),dblY ReDim yMax(rows-1), yM(cols-1) Dim edge(),edgeA(), edgeB(), span() ReDim edge(cols-1),edgeA(rows-1), edgeB(rows-1), span(rows*2) Dim cPt(1), oculi(1) r = 0 For i = 0 To cols - 1 Step 1 k = 0 If i > 0 Then r = r + mx(i - 1) + mn(i) + tabHeight * 2 End If For j = 0 To rows - 1 Step 1 ptX = array(r, 0, 0) For u = 0 To 3 Step 1 points(u) = Rhino.PointAdd(ptX, pts(i)(u)(j)) Next If j Mod (2) Then span(k) = Rhino.AddLine(points(0), points(3)) Call Rhino.ObjectLayer(span(k), "scores") k = k + 1 Else span(k) = Rhino.AddLine(points(1), points(2)) Call Rhino.ObjectLayer(span(k), "scores") k = k + 1 End If If j = 0 Then span(k) = Rhino.AddLine(points(0), points(1)) Call Rhino.ObjectLayer(span(k), "cuts") k = k + 1 End If If j = rows - 1 Then span(k) = Rhino.AddLine(points(2), points(3)) Call Rhino.ObjectLayer(span(k), "cuts") k = k + 1 Else span(k) = Rhino.AddLine(points(2), points(3)) Call Rhino.ObjectLayer(span(k), "scores") k = k + 1 End If If scale(i)(j) >= 0.1 Then If scale(i)(j) > 0.9 Then scale(i)(j) = 0.9 End If If j Mod (2) Then cPt(0) = incenter(points(0), points(2), points(3)) cPt(1) = incenter(points(0), points(1), points(3)) oculi(0) = innerEdge(cPt(0), array(points(0), points(2), points(3)), scale(i)(j)) oculi(1) = innerEdge(cPt(1), array(points(0), points(1), points(3)), scale(i)(j)) Else cPt(0) = incenter(points(0), points(1), points(2)) cPt(1) = incenter(points(2), points(1), points(3)) oculi(0) = innerEdge(cPt(0), array(points(0), points(1), points(2)), scale(i)(j)) oculi(1) = innerEdge(cPt(1), array(points(2), points(1), points(3)), scale(i)(j)) End If Call Rhino.ObjectLayer(oculi(0)(1), "cuts") Call Rhino.ObjectLayer(oculi(1)(1), "cuts") End If edgeA(j) = Rhino.AddLine(points(0), points(2)) Call Rhino.ObjectLayer(edgeA(j), "scores") edgeB(j) = Rhino.AddLine(points(1), points(3)) Call Rhino.ObjectLayer(edgeB(j), "scores") For u = 0 To 3 Step 1 yVal(u) = points(u)(1) Next yMax(j) = Rhino.Max(yVal) Next edge(i) = array(edgeA, edgeB) yM(i) = Rhino.Max(yMax) Next dblY = Rhino.Max(yM) Dim tabA(), tabB(), lblA(), lblB() ReDim tabA(rows-1), tabB(rows-1), lblA(rows-1), lblB(rows-1) For i = 0 To cols - 1 Step 1 For j = 0 To rows - 1 Step 1 tabA(j) = tabMaker(edge(i)(0)(j), -90, tabHeight) tabB(j) = tabMaker(edge(i)(1)(j), 90, tabHeight) Call Rhino.ObjectLayer(tabA(j), "cuts") Call Rhino.ObjectLayer(tabB(j), "cuts") If i = cols - 1 Then lblB(j) = labelMaker(edge(i)(1)(j), CStr(prefix) & "." & cols - 1 & "." & j, tabHeight * .3, 0, True) Else lblB(j) = labelMaker(edge(i)(1)(j), CStr(prefix) & "." & i + 1 & "." & j, tabHeight * .3, 0, True) End If lblA(j) = labelMaker(edge(i)(0)(j), CStr(prefix) & "." & i & "." & j, tabHeight * .3, 180, True) Next Next UnfoldMe = dblY End Function Function tabMaker(curve, rotVal, scale) tabMaker = Null Dim tabLN(1), tabPT(2),crvDom, wrldCS, i crvDom = Rhino.CurveDomain(curve) wrldCS = Rhino.WorldXYPlane() tabPT(0) = Rhino.CurveStartPoint(curve) tabPT(2) = Rhino.CurveEndPoint(curve) tabPT(1) = Rhino.PointAdd(Rhino.EvaluateCurve(curve, crvDom(1) * .5),Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorRotate(Rhino.VectorCreate(Rhino.EvaluateCurve(curve, crvDom(1) * .4),tabPT(2)),rotVal, wrldCS(3))),scale)) For i = 0 To 1 Step 1 tabLN(i) = Rhino.AddLine(tabPT(i), tabPT(i + 1)) Next tabMaker = tabLN End Function Function labelMaker(curve, title, size, angle, blnAlign) labelMaker = Null Dim txt, wrldCS If Rhino.IsLayer("numbering") = False Then Call Rhino.AddLayer("numbering", RGB(0, 255, 0)) End If wrldCS = Rhino.WorldXYPlane() txt = Rhino.AddText(title, Rhino.CurveMidPoint(curve), size) If blnAlign = True Then Call Rhino.TextObjectPlane(txt, array(Rhino.CurveMidPoint(curve), Rhino.VectorCreate(Rhino.CurveMidPoint(curve), Rhino.CurveEndPoint(curve)), Rhino.VectorRotate(Rhino.VectorCreate(Rhino.CurveMidPoint(curve), Rhino.CurveEndPoint(curve)), 90, wrldCS(3)), wrldCS(3))) Call Rhino.RotateObject(txt, Rhino.CurveMidPoint(curve), angle, wrldCS(3)) End If Call Rhino.ObjectLayer(txt, "numbering") labelMaker = txt End Function Function reparameterize(strObjectID) If Rhino.IsCurve(strObjectID) = True Then Call rhino.SelectObject(strObjectID) Call rhino.Command("reparameterize 0 1") Call rhino.UnselectAllObjects() End If If Rhino.IsSurface(strObjectID) = True Then Call rhino.SelectObject(strObjectID) Call rhino.Command("reparameterize 0 1 0 1") Call rhino.UnselectAllObjects() End If End Function Function incenter(ptA, ptB, ptC) incenter = Null Dim A,B,C Dim x,y,z A = Rhino.Distance(PtB, ptC) B = Rhino.Distance(PtA, ptC) C = Rhino.Distance(ptA, ptB) x = (ptA(0) * A + ptB(0) * B + ptC(0) * C) / (A + B + C) y = (ptA(1) * A + ptB(1) * B + ptC(1) * C) / (A + B + C) z = (ptA(2) * A + ptB(2) * B + ptC(2) * C) / (A + B + C) incenter = array(x, y, z) End Function Function innerEdge(cent, arrPoints, scale) innerEdge = Null Dim i, count count = uBound(arrPoints) Dim dist,pt(), edge() ReDim pt(count), edge(count) For i = 0 To count Step 1 dist = Rhino.Distance(cent, arrPoints(i)) pt(i) = Rhino.PointAdd(arrPoints(i), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(cent, arrPoints(i))), dist * scale)) Next For i = 0 To count Step 1 If i = 0 Then edge(i) = Rhino.AddLine(pt(count), pt(0)) Else edge(i) = Rhino.AddLine(pt(i), pt(i - 1)) End If Next innerEdge = array(pt, edge) End Function Function innerSurf(cent, arrPoints, scale) innerSurf = Null Dim i, count count = uBound(arrPoints) Dim dist,pt(), srf() ReDim pt(count), srf(count) For i = 0 To count Step 1 dist = Rhino.Distance(cent, arrPoints(i)) pt(i) = Rhino.PointAdd(arrPoints(i), Rhino.VectorScale(Rhino.VectorUnitize(Rhino.VectorCreate(cent, arrPoints(i))), dist * scale)) Next For i = 0 To count Step 1 If i = 0 Then srf(i) = Rhino.AddSrfPt(array(pt(count), pt(0), arrPoints(0), arrPoints(count))) Else srf(i) = Rhino.AddSrfPt(array(pt(i), pt(i - 1), arrPoints(i - 1), arrPoints(i))) End If Next innerSurf = array(pt, srf) End Function Function arrImageSample(cols, rows) arrImageSample = Null 'Instantiate the RhPicture Object Dim RhPicture : Set RhPicture = Rhino.GetPlugInObject("RhPicture") If IsNull(RhPicture) Then Exit Function 'Load an arbitrary image If Not RhPicture.LoadImage() Then Call Rhino.Print("Image not loaded") Exit Function End If 'Get the width and height Dim w : w = RhPicture.Width() Dim h : h = RhPicture.Height() If IsNull(w) Or IsNull(h) Then Call Rhino.Print("No valid image data") Exit Function End If Dim x, y, i,j Dim r, g, b, a, hu, s, u ReDim r(rows), g(rows), b(rows), a(rows), hu(rows), s(rows), u(rows) Dim rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet ReDim rValSet(cols), gValSet(cols), bValSet(cols), aValSet(cols), hValSet(cols), sValSet(cols), uValSet(cols) 'Sample Image returning all values between zero and one For i = 0 To cols Step 1 For j = 0 To rows Step 1 x = int(w / cols) * i y = int(h / rows) * j If x > w Then x = w End If If y > h Then y = h End If r(j) = RhPicture.Red(x, y) / 255 g(j) = RhPicture.Green(x, y) / 255 b(j) = RhPicture.Blue(x, y) / 255 a(j) = RhPicture.Alpha(x, y) / 255 hu(j) = RhPicture.Hue(x, y) / 360 s(j) = RhPicture.Saturation(x, y) u(j) = RhPicture.Luminance(x, y) Next rValSet(i) = r gValSet(i) = g bValSet(i) = b aValSet(i) = a hValSet(i) = hu sValSet(i) = s uValSet(i) = u Next Set RhPicture = Nothing ' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance arrImageSample = array(rValSet, gValSet, bValSet, aValSet, hValSet, sValSet, uValSet) End Function Function arrayValue(cols, rows, value) arrayValue = Null Dim i,j ReDim val(rows), arrVal(cols) For i = 0 To cols Step 1 For j = 0 To rows Step 1 val(j) = value Next arrVal(i) = val Next arrayValue = arrVal End Function