#StackBounty: Produce a Linear Cut List for Woodworking

Bounty: 50

I was inspired to write this by a recent review of cutting pipes.

The only thing I’m really iffy about is using the WriteCuts method. I couldn’t figure out a way to Let listOfCuts() out of Class TwoByFour.

Example

If you want to build a table (out of 2x4s), you’ll need

  • 4 legs of x length
  • 2 long sides of y length and
  • 2 short sides of z length

enter image description here

This could be represented in a table like so –

Length  Qty
48      4
30      2
15      2

Assuming length is in imperial inches and I can only buy 96″ boards at the store, I want to know how many boards I need to buy to get the lengths and quantities I want. In this (theoretical) case I need to buy 3 boards –

Board   Cuts        Remainder
1       48, 48         0
2       48, 30, 15     3
3       48, 30, 15     3

enter image description here


Algorithm

So with this simplified explanation, I can figure out my cuts by using the board’s off-cut piece for each length until I need a new board. This is the algorithm I’m using.


Pseudocode –

  1. Put length/qty table in array
  2. Create list of pieces (descending in length)
  3. Use a board until you can’t make another piece
  4. Get another board
  5. Repeat until all pieces are cut

Class TwoByFour

Option Explicit
    Const BOARD_LENGTH As Long = 96
    Private index As Long
    Private remainder As Double
    Private listOfCuts() As Double

    Private Sub Class_Initialize()
        ReDim listOfCuts(1 To 1)
        listOfCuts(1) = BOARD_LENGTH
    End Sub

    Public Property Get NumberOfCuts() As Long
        NumberOfCuts = UBound(listOfCuts)
    End Property

    Public Property Get Offcut() As Double
        Offcut = listOfCuts(UBound(listOfCuts))
    End Property

    Public Sub MakeCut(length As Double)
        index = UBound(listOfCuts)
        remainder = listOfCuts(index) - length
        listOfCuts(index) = length
        ReDim Preserve listOfCuts(1 To index + 1)
        listOfCuts(index + 1) = remainder
    End Sub

    Public Function WriteCuts() As Variant
        WriteCuts = listOfCuts
    End Function

Code

Option Explicit
Public Sub DimensionalLumberCutList()

    Dim lastRow As Long
    lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    Dim listOfComponents() As Double
    listOfComponents = GetListOfComponents(lastRow)

    Dim lumberStack As Collection
    Set lumberStack = New Collection
    Dim board As TwoByFour
    Dim boardCount As Long
    Dim index As Long


    Do
        Set board = New TwoByFour
        For index = LBound(listOfComponents) To UBound(listOfComponents)
            If board.Offcut < listOfComponents(UBound(listOfComponents)) Then
                lumberStack.Add board
                Exit For
            End If
            If board.Offcut > listOfComponents(index) And listOfComponents(index) <> 0 Then
                board.MakeCut listOfComponents(index)
                listOfComponents(index) = 0
            End If
            If index = UBound(listOfComponents) Then
                lumberStack.Add board
                Exit For
            End If
        Next
    Loop While Application.WorksheetFunction.Sum(listOfComponents) > 0


    With Sheet2
        .UsedRange.Clear
        For index = 1 To lumberStack.Count
            .Range(.Cells(index, 1), .Cells(index, lumberStack(index).NumberOfCuts)) = lumberStack(index).WriteCuts
        Next
    End With

End Sub


Private Function GetListOfComponents(ByVal lastRow As Long) As Double()
    Dim componentDataArray As Variant
    componentDataArray = PopulateComponentDataArray(lastRow)
    Dim numberOfComponents As Long
    numberOfComponents = GetNumberOfComponents(componentDataArray)
    Dim componentDoubleArray() As Double
    ReDim componentDoubleArray(1 To numberOfComponents)
    Dim index As Long
    index = 1
    Dim counter As Long
    Dim quantityOfEach As Long
    For counter = 1 To lastRow - 1
        For quantityOfEach = 1 To componentDataArray(counter, 2)
            componentDoubleArray(index) = componentDataArray(counter, 1)
            index = index + 1
        Next
    Next
    CombSortNumbers componentDoubleArray
    GetListOfComponents = componentDoubleArray
End Function

Private Function PopulateComponentDataArray(ByVal lastRow As Long) As Variant
    Dim componentRange As Range
    Set componentRange = Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(lastRow, 2))
    PopulateComponentDataArray = componentRange
End Function

Private Function GetNumberOfComponents(ByVal componentDataArray As Variant) As Long
    Dim counter As Long
    For counter = LBound(componentDataArray) To UBound(componentDataArray)
        GetNumberOfComponents = GetNumberOfComponents + componentDataArray(counter, 2)
    Next
End Function

Private Function GetTotalLength(ByVal listOfComponents As Variant) As Double
    Dim index As Long
    For index = LBound(listOfComponents) To UBound(listOfComponents)
        GetTotalLength = GetTotalLength + listOfComponents(index)
    Next
End Function

Combsort

I’m utilizing a previous piece of code that’s been reviewed to sort the array descending, but here it is anyway –

Private Sub CombSortNumbers(ByRef numberArray() As Double, Optional ByVal sortAscending As Boolean = False)
    Const SHRINK As Double = 1.3
    Dim initialSize As Long
    initialSize = UBound(numberArray())
    Dim gap As Long
    gap = initialSize
    Dim index As Long
    Dim isSorted As Boolean

    Do While gap > 1 And Not isSorted
        gap = Int(gap / SHRINK)
        If gap > 1 Then
            isSorted = False
        Else
            gap = 1
            isSorted = True
        End If
        index = LBound(numberArray)
        Do While index + gap <= initialSize
            If sortAscending Then
                If numberArray(index) > numberArray(index + gap) Then
                    SwapElements numberArray, index, index + gap
                    isSorted = False
                End If
            Else
                If numberArray(index) < numberArray(index + gap) Then
                    SwapElements numberArray, index, index + gap
                    isSorted = False
                End If
            End If
            index = index + 1
        Loop
    Loop

End Sub

Private Sub SwapElements(ByRef numberArray() As Double, ByVal i As Long, ByVal j As Long)
    Dim temporaryHolder As Double
    temporaryHolder = numberArray(i)
    numberArray(i) = numberArray(j)
    numberArray(j) = temporaryHolder
End Sub


Get this bounty!!!

Leave a Reply