Median Surface

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

---

This tool derives the median surface from a selected set of surfaces and places it at the origin point of a scene. As an early version of a tool, it is interesting, but the functional value is still undetermined and very much open to suggestions.

---

Option Explicit
'Script written by <insert name>
'Script copyrighted by <insert company name>
'Script version Monday, March 17, 2008 6:54:49 PM
 
Call Main()
Sub Main()
    Dim objects, object
    objects = Rhino.GetObjects("Select Surfaces", 8)
    If isNull(objects) Then Exit Sub
    Call Rhino.EnableRedraw(False)
    object = MedianObject(objects)
    Call Rhino.EnableRedraw(True)
     
End Sub
Function MedianObject(surfaces)
    MedianObject = Null
    Dim i,j,k,r,m
    Dim Ucount,Vcount,Udom,Vdom,objCount,pCount,pDom
    Dim arrU(),arrV(),domU(),domV()
    Dim tempPtSet
    Dim srfPts(),srfPtSet(),arrSrfPts(),ctrlCrvPts()
    objCount = uBound(surfaces)
    ReDim arrU(objCount), arrV(objCount),domU(objCount),domV(objCount)
    'Find out existing surface parameters
    For i = 0 To objCount Step 1
        pCount = Rhino.SurfacePointCount(surfaces(i))
        pDom = Rhino.SurfaceDegree(surfaces(i))
        arrU(i) = pCount(0)
        arrV(i) = pCount(1)
        domU(i) = pDom(0)
        domV(i) = pDom(1)
        'Call Rhino.Print(arrU(i))
        'Call Rhino.Print(arrV(i))
    Next
    'find you maximum values
    Dim surfRe, objCopy
    Udom = Rhino.Max(domU)
    Vdom = Rhino.Max(domV)
    Ucount = Rhino.Max(arrU)
    Vcount = Rhino.Max(arrV)
     
    Dim ptCount: ptCount = Ucount * Vcount - 1
     
    Dim ptX(), ptY(), ptZ(),ptXset(),ptYset(),ptZset()
    Dim srfXmin(),srfYmin(),srfZmin()
    ReDim srfPts(Vcount),srfPtSet(Ucount),arrSrfPts(objCount)
    ReDim ptX(ptCount), ptY(ptCount), ptZ(ptCount),ptXset(objCount),ptYset(objCount),ptZset(objCount)
    ReDim srfXmin(objCount),srfYmin(objCount),srfZmin(objCount)
     
    'rebuild the surfaces based on max values
    For i = 0 To objCount Step 1
        objCopy = Rhino.CopyObject(surfaces(i))
        Call Rhino.ObjectColor(objCopy, RGB(255, 0, 0))
        surfRe = Rhino.RebuildSurface(objCopy, array(Udom, Vdom), array(Ucount, Vcount))
        srfPts(i) = Rhino.SurfacePoints(objCopy)
        'extract control points
        For j = 0 To ptCount Step 1
            ptX(j) = srfPts(i)(j)(0)
            ptY(j) = srfPts(i)(j)(1)
            ptZ(j) = srfPts(i)(j)(2)
        Next
        srfXmin(i) = Rhino.Min(ptX)
        srfYmin(i) = Rhino.Min(ptY)
        srfZmin(i) = Rhino.Min(ptZ)
        'normalize the point sets
        For j = 0 To ptCount Step 1
            ptX(j) = ptX(j) - srfXmin(i)
            ptY(j) = ptY(j) - srfYmin(i)
            ptZ(j) = ptZ(j) - srfZmin(i)
        Next
        ptXset(i) = ptX
        ptYset(i) = ptY
        ptZset(i) = ptZ
        Call Rhino.DeleteObject(objCopy)
    Next
    'construct a surface at the model space centerpoint which is the median of the existing surfaces
    Dim ptMed(), ptXmed, ptYmed(), ptZmed(), ptXtemp(), ptYtemp(), ptZtemp()
    ReDim ptMed(ptCount), ptXmed(ptCount), ptYmed(ptCount), ptZmed(ptCount), ptXtemp(objCount), ptYtemp(objCount), ptZtemp(objCount)
    For i = 0 To ptCount Step 1
        For j = 0 To objCount Step 1
            ptXtemp(j) = ptXset(j)(i)
            ptYtemp(j) = ptYset(j)(i)
            ptZtemp(j) = ptZset(j)(i)
        Next
        ptXmed(i) = Rhino.Sum(ptXtemp) / (objCount + 1)
        ptYmed(i) = Rhino.Sum(ptYtemp) / (objCount + 1)
        ptZmed(i) = Rhino.Sum(ptZtemp) / (objCount + 1)
         
        ptMed(i) = array(ptXmed(i), ptYmed(i), ptZmed(i))
    Next
    Dim endSurf
    endSurf = Rhino.AddSrfControlPtGrid(array(Ucount, Vcount), ptMed, array(Udom, Vdom))
     
     
    MedianObject = endSurf
End Function

---