top of page
Writer's pictureDavid Mans
Jan 49 min read

Expanded Surface

šŸ’» Rhino 5

šŸ”¼ Rhino Script

šŸ› ļø Visual Basic

Ā 

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.

Ā 
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) &amp; "." &amp; cols - 1 &amp; "." &amp; j, tabHeight * .3, 0, True)
            Else
                lblB(j) = labelMaker(edge(i)(1)(j), CStr(prefix) &amp; "." &amp; i + 1 &amp; "." &amp; j, tabHeight * .3, 0, True)
            End If
            lblA(j) = labelMaker(edge(i)(0)(j), CStr(prefix) &amp; "." &amp; i &amp; "." &amp; 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
Ā 


0 views

Recent Posts

See All
bottom of page