top of page
  • Writer's pictureDavid Mans

Pack It

💻 Rhino 5

🔼 Rhino Script

🛠️ Visual Basic

 

This Rhino Script allows the user to pack a series of curves into a set boundary with several options for scaling, orientation, sorting, and numbering.

 
Option Explicit
'Script written by <David Mans>
'Script copyrighted by <NeoArchaic Design>
'Script version Wednesday, April 30, 2008 4:08:50 PM
 
Call Main()
Sub Main()
    Dim objects,inputs,width,height,scale,boarder
    objects = Rhino.GetObjects("Select Curves")
    If isNull(objects) Then Exit Sub
    Dim i,r,s, blnGrp(), grp,ngrp, count
    grp = False: ngrp = False
    i = 0: r = 0: s = 0
    ReDim blnGrp(uBound(objects))
    Dim groups, obj(), grps()
    ReDim grps(r),obj(s)
    For i = 0 To uBound(objects) Step 1
        If Rhino.IsObjectInGroup(objects(i)) Then
            ReDim Preserve grps(r)
            grps(r) = objects(i)
            grp = True
            r = r + 1
        Else
            ReDim Preserve obj(s)
            obj(s) = objects(i)
            blnGrp(s) = False
            ngrp = True
            s = s + 1
        End If
    Next
    s = 0
    If grp = True And ngrp = False Then
        ReDim blnGrp(0)
        inputs = groupsFromObjects(objects)
        For i = 0 To uBound(inputs) Step 1
            ReDim Preserve blnGrp(i)
            blnGrp(i) = True
        Next
    End If
    If ngrp = True And grp = False Then
        inputs = objects
        For i = 0 To uBound(inputs) Step 1
            blnGrp(i) = False
        Next
    End If
    If grp = True And ngrp = True Then
        groups = groupsFromObjects(grps)
        count = uBound(groups) + uBound(obj) + 1
        ReDim inp(count)
        For i = 0 To uBound(groups) Step 1
            inp(s) = groups(i)
            blnGrp(s) = True
            s = s + 1
        Next
        For i = 0 To uBound(obj) Step 1
            inp(s) = obj(i)
            blnGrp(s) = False
            s = s + 1
        Next
        inputs = inp
    End If
     
     
    Dim arrItems, arrValues, arrReturns
    arrItems = array("Maximum_Width", "Maximum_Height", "Scale_Factor", "Boarder_Width", "Rotational_Alignment", "World_Orientation")
    arrValues = array(32, 18, 1, .25, True, True)
    arrReturns = Rhino.PropertyListBox(arrItems, arrValues,, "Transform Parameters")
    If isNull(arrReturns) Then Exit Sub
     
    Call Rhino.EnableRedraw(False)
    Call TileCurves(inputs, CDbl(arrReturns(0)), CDbl(arrReturns(1)), CDbl(arrReturns(2)), CDbl(arrReturns(3)), CBool(arrReturns(4)), CBool(arrReturns(5)), blnGrp)
    Call Rhino.EnableRedraw(True)
     
End Sub
Function TileCurves(curves, width, height, scale, board, align, orient, group)
    TileCurves = Null
    Dim i,j,k,r,s,t,u,v,a,stps,count
    count = uBound(curves)
    Dim tempCv,testCv,wPlane,sort,minH,minR,tBox,tempTxt
    wPlane = Rhino.WorldXYPlane()
    ReDim bBox(count),wid(count),hgt(count),obj(count),centPt(count),cutObj(count),txtH(count),lblH(count)
    ReDim h(count),w(count),c(count),cA(count),rotVal(count)
    ReDim areaV(89)
     
    If Rhino.IsLayer("scores") = False Then
        Call Rhino.AddLayer("scores", RGB(255, 0, 0))
    End If
    If Rhino.IsLayer("labels") = False Then
        Call Rhino.AddLayer("labels", RGB(0, 0, 0))
    End If
    If Rhino.IsLayer("cuts") = False Then
        Call Rhino.AddLayer("cuts", RGB(0, 255, 0))
    End If
    If Rhino.IsLayer("frame") = False Then
        Call Rhino.AddLayer("frame", RGB(0, 0, 0))
    End If
    'create cutting reference box
    Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(0, 0, 0), array(0, height, 0), array(width, height, 0), array(width, 0, 0), array(0, 0, 0))), "frame")
    Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(board, board, 0), array(board, height - board, 0), array(width - board, height - board, 0), array(width - board, board, 0), array(board, board, 0))), "frame")
     
    'determine boundry dimensions and copy object for packing   
    Dim oPts, obox, oArea(), oMin
    For i = 0 To count Step 1
        If group(i) = True Then
            testCv = Rhino.CopyObjects(curves(i))
        Else
            testCv = Rhino.CopyObject(curves(i))
        End If
        'search for optimal orientation based on curve points, optimal for boxes.
        ' Will Not Work If Objects Are Grouped!
        If group(i) = False Then
            If orient = True Then
                oPts = Rhino.CurveEditPoints(testCv)
                s = 0
                ReDim oArea(s), oOri(s)
                For j = 0 To uBound(oPts) - 1 Step 1
                    For k = j To uBound(oPts) - 1 Step 1
                        If j <> k Then
                            ReDim Preserve oArea(s), oOri(s)
                            oPts = Rhino.CurveEditPoints(testCv)
                            oOri(s) = array(j, k)
                            Call Rhino.OrientObject(testCv, array(oPts(j), oPts(k)), array(oPts(j), array(oPts(j)(0), oPts(j)(1) + 1, oPts(j)(2))))
                            obox = Rhino.BoundingBox(testCv)
                            oArea(s) = Rhino.Distance(obox(0), obox(1)) * Rhino.Distance(obox(0), obox(3))
                            s = s + 1
                        End If
                    Next
                Next
                oMin = Rhino.Min(oArea)
                k = 0: j = 0
                Do Until j = s Or k = 1
                    If oArea(j) = oMin Then
                        oPts = Rhino.CurveEditPoints(testCv)
                        Call Rhino.OrientObject(testCv, array(oPts(oOri(j)(0)), oPts(oOri(j)(1))), array(oPts(oOri(j)(0)), array(oPts(oOri(j)(0))(0), oPts(oOri(j)(0))(1) + 1, oPts(oOri(j)(0))(2))))
                        k = 1
                    End If
                    j = j + 1
                Loop
            End If
        End If
         
        bBox(i) = Rhino.BoundingBox(testCv)
        tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
        centPt(i) = Rhino.CurveMidPoint(tempCv)
        Call Rhino.DeleteObject(tempCv)
        If align = True Then
            For j = 0 To 89 Step 1
                If group(i) = True Then
                    Call Rhino.RotateObjects(testCv, centPt(i), 1, wPlane(3))
                Else
                    Call Rhino.RotateObject(testCv, centPt(i), 1, wPlane(3))
                End If
                tBox = Rhino.BoundingBox(testCv)
                areaV(j) = Rhino.Distance(tBox(0), tBox(1)) * Rhino.Distance(tBox(0), tBox(3))
            Next
            If group(i) = True Then
                Call Rhino.RotateObjects(testCv, centPt(i), -89, wPlane(3))
            Else
                Call Rhino.RotateObject(testCv, centPt(i), -89, wPlane(3))
            End If
            minR = Rhino.Min(areaV)
            For j = 0 To 89 Step 1
                If areaV(j) = minR Then
                    rotVal(i) = j
                End If
            Next
        End If
         
        obj(i) = testCv
        If align = True Then
            If group(i) = True Then
                Call Rhino.RotateObjects(obj(i), centPt(i), rotVal(i), wPlane(3))
            Else
                Call Rhino.RotateObject(obj(i), centPt(i), rotVal(i), wPlane(3))
            End If
        End If
        bBox(i) = Rhino.BoundingBox(obj(i))
        wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
        hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
        txtH(i) = hgt(i)
        'scale packing objects and rotate to maximize packing
        If wid(i) < hgt(i) Then
            txtH(i) = wid(i)
            If group(i) = True Then
                Call Rhino.RotateObjects(obj(i), centPt(i), 90, wPlane(3))
            Else
                Call Rhino.RotateObject(obj(i), centPt(i), 90, wPlane(3))
            End If
        End If
        If group(i) = True Then
            Call Rhino.ScaleObjects(obj(i), centPt(i), array(scale, scale, 1))
        Else
            Call Rhino.ScaleObject(obj(i), centPt(i), array(scale, scale, 1))
        End If
        bBox(i) = Rhino.BoundingBox(obj(i))
        tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
        centPt(i) = Rhino.CurveMidPoint(tempCv)
        Call Rhino.DeleteObject(tempCv)
        wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
        hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
    Next
    If  Rhino.Max(wid) - Rhino.Min(wid) > Rhino.Max(hgt) - Rhino.Min(hgt) Then
        For i = 0 To count Step 1
            If group(i) = True Then
                Call Rhino.RotateObjects(obj(i), centPt(i), 90, wPlane(3))
            Else
                Call Rhino.RotateObject(obj(i), centPt(i), 90, wPlane(3))
            End If
            bBox(i) = Rhino.BoundingBox(obj(i))
            tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
            centPt(i) = Rhino.CurveMidPoint(tempCv)
            Call Rhino.DeleteObject(tempCv)
            wid(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
            hgt(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
        Next
        v = True
    Else
        v = False
    End If 
     
     
    sort = Rhino.SortNumbers(wid, False)
    minH = Rhino.Min(hgt)
    If minH < .1 Then
        minH = .1
    End If
     
    'conditional reDimensions array through an elimination process preventing duplicates
    Dim tmpObj,tmpWid,blnMe
    tmpObj = obj
    tmpWid = wid
    For i = 0 To count Step 1
        a = 0
        blnMe = False
        For j = 0 To count - i Step 1
            If sort(i) = tmpWid(j) And blnMe = False Then
                cutObj(i) = tmpObj(j)
                 
                blnMe = True
            Else
                tmpObj(a) = tmpObj(j)
                tmpWid(a) = tmpWid(j)
                txtH(a) = txtH(j)
                 
                a = a + 1
            End If
        Next
        ReDim Preserve tmpObj(count-i-1)
        ReDim Preserve tmpWid(count-i-1)
    Next
     
    'Resequence according to scale to maximize wasted space 
    For i = 0 To count Step 1
        bBox(i) = Rhino.BoundingBox(cutObj(i))
        tempCv = Rhino.AddLine(bBox(i)(0), bBox(i)(2))
        c(i) = Rhino.CurveMidPoint(tempCv)
        h(i) = Rhino.Distance(bBox(i)(0), bBox(i)(3))
        w(i) = Rhino.Distance(bBox(i)(0), bBox(i)(1))
        Call Rhino.DeleteObject(tempCv)
        Call Rhino.ObjectLayer(cutObj(i), "cuts")
    Next
    'check that objects are within frame dimensions
    For i = 0 To count Step 1
        If h(i) > height - board * 2 Then
            Call Rhino.Print("Object to Large to Cut")
            Call Rhino.ObjectColor(cutObj(i), RGB(255, 255, 255))
            Exit Function
        End If
        If w(i) > width - board * 2 Then
            Call Rhino.Print("Object to Large to Cut")
            Call Rhino.ObjectColor(cutObj(i), RGB(255, 255, 255))
            Exit Function
        End If
    Next
    'pack according to dimensional limits 
    r = board
    s = board
    t = 0
    u = 0
    Dim lblTxt, xbox, xln
    For i = 0 To count Step 1
        xbox = Rhino.BoundingBox(curves(i))
        xln = Rhino.AddLine(xbox(0), xbox(2))
        lblTxt = Rhino.AddText(i, Rhino.CurveMidPoint(xln), txtH(count - i) * .5)
        Call Rhino.DeleteObject(xln)
        Call Rhino.ObjectLayer(lblTxt, "labels")
        If s + board + h(i) > height - board Then
            s = board
            r = r + t + w(i) * .5
            t = w(i) * .5
        End If
         
        If r + w(i) * .5 > width*u+width - board * 2 Then
            u = u + 1
            r = width * u + board + w(i) * .5
            Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width * u, 0, 0), array(width * u, height, 0), array(width * u + width, height, 0), array(width * u + width, 0, 0), array(width * u, 0, 0))), "frame")
            Call Rhino.ObjectLayer(Rhino.AddPolyline(array(array(width * u + board, board, 0), array(width * u + board, height - board, 0), array(width * u + width - board, height - board, 0), array(width * u + width - board, board, 0), array(width * u + board, board, 0))), "frame")
        End If
         
        If i = 0 Then
            r = board + w(i) * .5
            s = board + h(i) * .5
            t = w(i) * .5
            If group(i) = True Then
                Call Rhino.moveobjects(cutObj(i), c(i), array(r, s, 0))
            Else
                Call Rhino.moveobject(cutObj(i), c(i), array(r, s, 0))
            End If
            cA(i) = array(board, board, 0)
            s = s + h(i) * .5
        Else
            s = s + h(i) * .5
            If group(i) = True Then
                Call Rhino.moveobjects(cutObj(i), c(i), array(r, s, 0))
            Else
                Call Rhino.moveobject(cutObj(i), c(i), array(r, s, 0))
            End If
            cA(i) = array(r - w(i) * .5, s - h(i) * .5, 0)
            s = s + h(i) * .5
        End If
        If v = False Then
            Call Rhino.ObjectLayer(Rhino.AddText(i, cA(i), txtH(count - i) * scale * .5),"scores")
        Else
            tempTxt = Rhino.AddText(i, array(cA(i)(0) + w(i), cA(i)(1), cA(i)(2)), txtH(count - i) * scale * .5)
            Call Rhino.ObjectLayer(tempTxt, "scores")
            Call Rhino.RotateObject(tempTxt, array(cA(i)(0) + w(i), cA(i)(1), cA(i)(2)), 90, wPlane(3))
        End If
    Next
End Function
Function groupsFromObjects(obj)
    groupsFromObjects = Null
    Dim i,j,r,s, count, grp, box, grpObj()
    count = uBound(obj)
    ReDim grp(count), group(0)
    s = 0
    For i = 0 To count Step 1
        grp(i) = Rhino.ObjectTopGroup(obj(i))
        If i > 0 Then
            r = 0
            j = 0
            Do Until j = s 
                If  grp(i) <> group(j) Then
                    r = r + 1
                End If
                j = j + 1
            Loop
            If r = s Then
                ReDim Preserve group(s)
                group(s) = grp(i)
                s = s + 1
            End If
        Else
            group(s) = grp(i)
            s = 1
        End If
    Next
    ReDim grpObj(uBound(group))
    For i = 0 To uBound(group) Step 1
        grpObj(i) = Rhino.ObjectsByGroup(group(i))
    Next
    groupsFromObjects = grpObj
End Function
 


3 views

Recent Posts

See All

Komentáře


bottom of page