Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
A few years ago, a friend sent me this program. It is written in VBA for Microsoft Excel (shameful, I know, sorry). His focus was optimizing cuts in sheets of plywood. It should be possible to pick out the algorithm. It draws pretty pictures of the cuts as well. You enter a list of shapes in a few columns and a list of boards available in another few columns.
Private Sub cmdCrunch_Click() Dim PcLengthCol, PcWidthCol, PcStatCol, StLengthCol, StWidthCol, S +tStatCol, KerfCol, KerfRow, PcIDCol, StIDCol, PcQntCol, StQntCol As I +nteger Dim MaxYDraw, YDrawScale, XDim, YDim, DrawXStart, DrawYStart, MaxS +tLength, MaxStWidth, SubXStart, SubYStart As Integer Dim i, j, k, ArraySize, StartRow, PcListSize, StListSize, Row As I +nteger Dim YieldRow, YeildCol, SubYeildCol As Integer Dim UsedArea, StockArea, Yeild, RowHeight As Single Dim Stock(100, 4), Pieces(100, 5) As Variant Dim Length, Width, Kerf, LRemain, LWidth As Single Dim AutoPcID As Boolean Dim ID As String StartRow = 5 ArraySize = 100 PcIDCol = 1 PcLengthCol = 2 PcWidthCol = 3 PcQntCol = 4 PcStatCol = 5 StIDCol = 6 StLengthCol = 7 StWidthCol = 8 StQntCol = 9 StStatCol = 10 KerfRow = 4 KerfCol = 13 YeildRow = 5 YeildCol = 13 MaxYDraw = 300 DrawXStart = 390 DrawYStart = 100 MaxStWidth = 0 UsedArea = 0 StockArea = 0 AutoPcID = True AutoStID = True StListSize = 0 PcListSize = 0 SubYeildCol = 11 For Each sh In Worksheets(1).Shapes 'clears graphics 'if cell comments are inserted in worksheets, this loop will fail. If sh.Type <> msoOLEControlObject Then sh.Select Selection.Delete End If i = i + 1 Next Worksheets(1).Range("E6:F106").Select 'clears previous results Selection.ClearContents Worksheets(1).Range("J6:K106").Select Selection.ClearContents Worksheets(1).Range("M5").Select Selection.ClearContents Kerf = Worksheets(1).Cells(KerfRow, KerfCol).Value 'Reads Kerf val +ue If Kerf = "" Then Msg = MsgBox("No kerf value was entered, assume 1/8 inch?", 4, + "Whoooa!") If Msg = vbYes Then Kerf = 0.125 Worksheets(1).Cells(KerfRow, KerfCol) = 0.125 Else Worksheets(1).Range("L4").Select End End If End If If (Kerf > 0.25) And (Kerf < 3) Then Msg = MsgBox("Kerf is very large, proceed?", 4, "Whoooa!") If Msg <> vbYes Then Worksheets(1).Range("L4").Select End End If End If If Kerf >= 3 Then Msg = MsgBox("What the?! Kerf must be less than 3 inches!", 0, + "Whoooa!") Worksheets(1).Range("L4").Select End End If If Worksheets(1).Cells(StartRow + 1, PcIDCol) <> "" Then 'Checks i +f user inputted ID labels AutoPcID = False End If i = 1 'Determines size of Stock list, IDs the items Do Until i = ArraySize Length = Worksheets(1).Cells(StartRow + i, StLengthCol).Value +'Reads length Width = Worksheets(1).Cells(StartRow + i, StWidthCol).Value 'R +ead Width If (Length = "") Or (Width = "") Then 'If blank length value, +then exit If i = 1 Then Msg = MsgBox("No Stock values entered or blank dimensi +on value found at begining of Stock list!", vbCritical, "Whoooa!") End End If Exit Do End If Quantity = Worksheets(1).Cells(StartRow + i, StQntCol).Value If Quantity = "" Then 'if no Quantity amount entered, assume u +nity Quantity = 1 End If For j = (StListSize + 1) To (StListSize + Quantity) Stock(j, 1) = j 'ID Stock(j, 2) = Length Stock(j, 3) = Width Stock(j, 4) = -1 Next j StListSize = StListSize + Quantity 'Updates list size i = i + 1 Loop For i = 1 To StListSize 'Rewrites expanded Stock list Worksheets(1).Cells(StartRow + i, StIDCol) = Stock(i, 1) Worksheets(1).Cells(StartRow + i, StLengthCol) = Stock(i, 2) Worksheets(1).Cells(StartRow + i, StWidthCol) = Stock(i, 3) Worksheets(1).Cells(StartRow + i, StQntCol) = 1 Next i i = 1 'Determines size of Pieces list, IDs the items Do Until i = ArraySize Length = Worksheets(1).Cells(StartRow + i, PcLengthCol).Value Width = Worksheets(1).Cells(StartRow + i, PcWidthCol).Value If (Length = "") Or (Width = "") Then 'If blank length value, +then exit If i = 1 Then Msg = MsgBox("No Piece values entered or blank dimensi +on value found at begining of Pieces list!", vbCritical, "Whoooa!") End End If Exit Do End If If AutoPcID = False Then ID = Worksheets(1).Cells(StartRow + i, PcIDCol) 'Reads Use +r ID label Else ID = i 'Auto assigns ID End If Quantity = Worksheets(1).Cells(StartRow + i, PcQntCol).Value If Quantity = "" Then 'if no Quantity amount entered, assume u +nity Quantity = 1 End If For j = (PcListSize + 1) To (PcListSize + Quantity) Pieces(j, 1) = ID Pieces(j, 2) = Length Pieces(j, 3) = Width Pieces(j, 4) = -1 Pieces(j, 5) = -1 Next j PcListSize = PcListSize + Quantity i = i + 1 Loop For i = 1 To PcListSize Worksheets(1).Cells(StartRow + i, PcIDCol) = Pieces(i, 1) Worksheets(1).Cells(StartRow + i, PcLengthCol) = Pieces(i, 2) Worksheets(1).Cells(StartRow + i, PcWidthCol) = Pieces(i, 3) Worksheets(1).Cells(StartRow + i, PcQntCol) = 1 Next i Range("A6:D105").Select 'Sorts Pieces by Length then by Width ActiveWindow.ScrollRow = 1 Selection.Sort Key1:=Range("B6"), Order1:=xlDescending, Key2:=Rang +e("C6") _ , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, Match +Case:= _ False, Orientation:=xlTopToBottom For i = 1 To PcListSize 'Reads Pieces into array Pieces(i, 1) = Worksheets(1).Cells(StartRow + i, PcIDCol).Valu +e 'ID label Pieces(i, 2) = Worksheets(1).Cells(StartRow + i, PcLengthCol). +Value 'Length Pieces(i, 3) = Worksheets(1).Cells(StartRow + i, PcWidthCol).V +alue 'Width Pieces(i, 4) = -1 'Stock Status Pieces(i, 5) = -1 'Row Status Next i Range("F6:I105").Select 'Sorts Stock by Length then by Width ActiveWindow.ScrollRow = 1 Selection.Sort Key1:=Range("G6"), Order1:=xlDescending, Key2:=Rang +e("H6") _ , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, Match +Case:= _ False, Orientation:=xlTopToBottom For i = 1 To StListSize 'Reads Stock into array Stock(i, 1) = Worksheets(1).Cells(StartRow + i, StIDCol).Value + 'ID label Stock(i, 2) = Worksheets(1).Cells(StartRow + i, StLengthCol).V +alue + Kerf 'Length Stock(i, 3) = Worksheets(1).Cells(StartRow + i, StWidthCol).Va +lue + Kerf 'Width Stock(i, 4) = -1 'Status If Stock(i, 3) > MaxStWidth Then MaxStWidth = Stock(i, 3) Next i Worksheets(1).Range("A1").Select For i = 1 To StListSize 'Optimizing Routine LRemain = Stock(i, 2) Row = 0 For j = 1 To PcListSize 'for each Piece WRemain = Stock(i, 3) If (Pieces(j, 4) = -1) And (Pieces(j, 2) + Kerf <= LRemain +) And (Pieces(j, 3) + Kerf <= WRemain) Then 'if Row starter Piece is +unused and fits Row = Row + 1 'Add new Row LRemain = LRemain - Pieces(j, 2) - Kerf 'evaluate rema +ining Stock Length WRemain = WRemain - Pieces(j, 3) - Kerf ' evaluate rem +aining Row Width Pieces(j, 4) = Stock(i, 1) 'Labels Piece with Stock ID Pieces(j, 5) = Row ' Labels Piece with Row on Stock For k = (j + 1) To PcListSize If (Pieces(k, 4) = -1) And (Pieces(k, 3) + Kerf <= + WRemain) Then 'Unused and fits WRemain = WRemain - Pieces(k, 3) - Kerf ' eval +uate remaining Row Width Pieces(k, 4) = Stock(i, 1) 'Labels Piece with +Stock ID Pieces(k, 5) = Row ' Labels Piece with Row on +Stock End If Next k End If Next j Stock(i, 4) = Row 'how many rows of fitted Pieces per sheet of + stock Next i For i = 1 To PcListSize 'writes Piece Status If Pieces(i, 4) = -1 Then Worksheets(1).Cells(StartRow + i, PcStatCol) = "Not Cut" Else Worksheets(1).Cells(StartRow + i, PcStatCol) = "Cut" End If Next i For i = 1 To StListSize 'writes Stock Status If Stock(i, 4) = 0 Then Worksheets(1).Cells(StartRow + i, StStatCol) = "Not Used" Else Worksheets(1).Cells(StartRow + i, StStatCol) = "Used" End If Next i For i = 1 To PcListSize - 1 'Checks for large differences in Piece + lengths and tags them If (Pieces(i + 1, 2) / Pieces(i, 2) < 0.8) And (Pieces(i + 1, +4) <> -1) And (Pieces(i, 4) <> -1) Then Msg = MsgBox("Large differences in length of Pieces " & Pi +eces(i, 1) & " and " & Pieces(i + 1, 1) & " may result in inefficient + layout", 0, "Warning Only") Worksheets(1).Cells(StartRow + i, PcStatCol) = "+ Cut +" Worksheets(1).Cells(StartRow + i + 1, PcStatCol) = "+ Cut ++" End If Next i For j = 1 To StListSize 'calculates yeild for each Stock item UsedArea = 0 StockArea = (Stock(j, 2) - Kerf) * (Stock(j, 3) - Kerf) For i = 1 To PcListSize If Pieces(i, 4) = j Then UsedArea = UsedArea + Pieces(i, 2 +) * Pieces(i, 3) Next i Yeild = UsedArea / StockArea Worksheets(1).Cells(StartRow + j, SubYeildCol) = Yeild Next j UsedArea = 0 'calculates overall yeild StockArea = 0 For i = 1 To PcListSize If Pieces(i, 4) <> -1 Then UsedArea = UsedArea + Pieces(i, 2) +* Pieces(i, 3) Next i For i = 1 To StListSize If Stock(i, 4) <> 0 Then StockArea = StockArea + Stock(i, 2) * + Stock(i, 3) Next i If StockArea = 0 Then Msg = MsgBox("Pieces too large for Stock", 0, "Whoooa!") End End If Yeild = UsedArea / StockArea Worksheets(1).Cells(YeildRow, YeildCol) = Yeild MaxStLength = Stock(1, 2) 'Scales drawing size YDrawScale = Int(MaxYDraw / MaxStLength) For i = 1 To StListSize 'Drawing routine YDim = Stock(i, 2) * YDrawScale XDim = Stock(i, 3) * YDrawScale SubYStart = DrawYStart SubXStart = DrawXStart ActiveSheet.Shapes.AddShape(msoShapeRectangle, DrawXStart, Dra +wYStart, XDim, YDim).Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 41 ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, Draw +XStart + XDim / 2, DrawYStart - 15, 0#, 0#).Select Selection.Characters.Text = Str(Stock(i, 1)) For k = 1 To Stock(i, 4) 'For each row in Stock RowHeight = 0 SubXStart = DrawXStart 'Start X at beginning of Row For j = 1 To PcListSize 'For all Pieces If Pieces(j, 4) = i And Pieces(j, 5) = k Then 'if Piec +e is in Stock and in Row YDim = Pieces(j, 2) * YDrawScale 'Scale Piece size If YDim > RowHeight Then RowHeight = YDim XDim = Pieces(j, 3) * YDrawScale ActiveSheet.Shapes.AddShape(msoShapeRectangle, Sub +XStart, SubYStart, XDim, YDim).Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = +44 ActiveSheet.Shapes.AddLabel(msoTextOrientationHori +zontal, SubXStart + XDim / 2 - 8, SubYStart + YDim / 2 - 5, 0#, 0#).S +elect Selection.Characters.Text = Pieces(j, 1) SubXStart = SubXStart + XDim + Kerf * YDrawScale End If Next j SubYStart = SubYStart + RowHeight + Kerf * YDrawScale Next k DrawXStart = DrawXStart + (Stock(i, 3) * YDrawScale) + 10 Next i Worksheets(1).Range("A1").Activate End Sub Private Sub cmdReset_Click() Proceed = MsgBox("This will clear all previous outputs! Proceed?", + 4, "Whoooa!") If Proceed <> vbYes Then End Worksheets(1).Range("E6:F106").Select Selection.ClearContents Worksheets(1).Range("J6:K106").Select Selection.ClearContents Worksheets(1).Range("M5").Select Selection.ClearContents Worksheets(1).Range("A1").Activate For Each sh In Worksheets(1).Shapes 'clears graphics If sh.Type <> msoOLEControlObject Then sh.Select Selection.Delete End If i = i + 1 Next End Sub

Edit by castaway - added readmore tags


In reply to Re: Geometric Optimisation and Perl by Anonymous Monk
in thread Geometric Optimisation and Perl by stefzody

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (7)
As of 2024-03-28 12:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found