Scale Field by Image

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

---

This Rhino Script takes any image reads the luminance value of the image at a user-specified 2d increment and uses the results as a scalar multiplier against a user-specified value for a selected set of objects.

---

Option Explicit
'Script written by <David Mans>
'adapted from work by Che Wei Wang
'www.cwwang.com
'Script copyrighted by <NeoArchaic Studio>
'Script version Tuesday, March 18, 2008 7:40:18 AM
 
Call Main()
Sub Main()
    Dim arrObjects: arrObjects = Rhino.GetObjects("Select Objects",, True)
    If isNull(arrObjects) Then Exit Sub
     
    Dim arrItems, arrValues, arrResults
    arrItems = array("columns", "rows", "maximum_scale_height")
    arrValues = array(10, 10, 2)
    arrResults = Rhino.PropertyListBox(arrItems, arrValues,, "Image Parameters")
     
    Dim arrImg
     
    arrImg = arrImageSample(arrResults(0), arrResults(1))
    ' image outputs (0)red(1)green(2)blue(3)alpha(4)hue(5)saturation(6)luminance
     
     
    Call Rhino.EnableRedraw(False)
    Call scaleByImage(arrObjects, arrImg(6), CDbl(arrResults(2)))
    Call Rhino.DeleteObjects(arrObjects)
    Call Rhino.EnableRedraw(True)
     
End Sub
Function scaleByImage(arrObjects, arrValues, dblScale)
    scaleByImage = Null
    Dim i, j, x, y, bBox
     
    bBox = Rhino.BoundingBox(arrObjects)
    x = Rhino.Distance(bBox(0), bBox(1))
    y = Rhino.Distance(bBox(0), bBox(3))
     
    Dim arrOutput(),tOutput()
    ReDim arrOutput(uBound(arrValues))
     
    For i = 0 To uBound(arrValues) - 1 Step 1
        ReDim tOutput(uBound(arrValues(i)))
        For j = 0 To uBound(arrValues(i)) - 1 Step 1
            tOutput(j) = Rhino.ScaleObjects(Rhino.CopyObjects(arrObjects, array(0, 0, 0), array(x * i, y * j, 0)), array(0, 0, 0), array(1, 1, 1 + dblScale * arrValues(i)(j)))
        Next
        arrOutput(j) = tOutput
    Next
     
    scaleByImage = arrOutput
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

---