1: #!/usr/bin/tcl 2: # Find the best way to chop given amounts of stock in units specified 3: # -- RKeene [04/08/1999:17:30] 4: 5: ########################### 6: # VERSION NUMBER ########## 7: ########################### 8: 9: set VER "0.9.07" 10: 11: # Proc's.. In alphabetical order 12: proc CheckS {num} { 13: if {$num!=1} { return "s" } else { return "" } 14: } 15: proc ifnull {text ifnull ifnotnull} { 16: if {$text==""} { return $ifnull } else { return $ifnotnull } 17: } 18: proc ParseYN {text} { 19: set text [string range [string toupper $text] 0 1] 20: if {$text=="1" || [string index $text 0]=="Y" || $text=="ON"} { return 1 } 21: if {$text=="0" || [string index $text 0]=="N" || $text=="OF"} { return 0 } 22: } 23: proc PrintHELP {} { 24: global argv0 VER 25: puts "Usage: $argv0 \[-hwcvn\[v\]\] \[--format=<short,normal,medium,long>\] \[--help\] \[--\[very\]verbose\] \[--slen=<num>\] \[--precision=<num,1-17>\] \[--version\] \[--color\] \[--nocolor\] \[--\] <file>" 26: puts "" 27: puts "\t-h, --help\tPrints this help screen." 28: puts "\t-v, --verbose\tTurns up the verbosity." 29: puts "\t-w, --waste\tDoes not display wasted materials." 30: puts "\t-c, --color\tEnables colorized output (overides datafile)." 31: puts "\t-n, --nocolor\tDisables colorized output (overides datafile)." 32: puts "\t --format\tChanges the format of the results." 33: puts "\t --slen\tOverrides the length of stock used from file." 34: puts "\t --precision\tChanges the number of decimal places calculated." 35: puts "\t --version\tDisplays the version number ($VER)." 36: puts "" 37: } 38: proc ProccessCmdline {argv} { 39: global RealFormat filename Verbose SLEN NoWaste VER CheckVerExit Colord 40: set Stopscan 0 41: set Verbose 0 42: foreach arg $argv { 43: set cmd [string range [string tolower [lindex [split $arg =] 0]] 1 end] 44: if {[string index $arg 0]!="-" || $Stopscan} { set filename $arg } 45: if {[string index $arg 0]=="-" && [string index $cmd 0]!="-" && [string length $cmd]!=1} { 46: set eachlet "" 47: for {set m 0} {$m <= [string length $cmd]} {incr m} { 48: set eachlet "$eachlet [string index $cmd $m]" 49: } 50: } else { 51: set eachlet $cmd 52: } 53: if {$Stopscan} { set eachlet "" } 54: foreach cmda [string trim $eachlet] { 55: switch -exact -- $cmda { 56: "h" { PrintHELP ; exit } 57: "w" { set NoWaste 1 } 58: "v" { incr Verbose 1 } 59: "c" { set Colord 1 } 60: "n" { set Colord 0 } 61: "-format" { set RealFormat [lindex [split $arg =] 1] } 62: "-help" { PrintHELP ; exit } 63: "-verbose" { set Verbose 1 } 64: "-veryverbose" { set Verbose 2 } 65: "-slen" { set SLEN [lindex [split $arg =] 1] } 66: "-precision" { set tcl_precision [lindex [split $arg =] 1] } 67: "-waste" { set NoWaste 1 } 68: "-version" { puts "chopstock version $VER." ; set CheckVerExit 1 } 69: "-color" { set Colord 1 } 70: "-nocolor" { set Colord 0 } 71: "-" { set Stopscan 1 } 72: } 73: } 74: } 75: } 76: proc ReturnSmallest {arg1 arg2} { 77: if {$arg1<$arg2} { return $arg1 } else { return $arg2 } 78: } 79: 80: 81: # Start here. 82: set filename "" 83: set RealFormat "" 84: set Verbose 0 85: set SLEN 0 86: set NoWaste 0 87: set CheckVerExit 0 88: set Colord -1 89: ProccessCmdline $argv 90: if {$filename=="" && $CheckVerExit} { exit } 91: if {$filename==""} { PrintHELP ; exit } 92: set fileId [open $filename r] 93: set ChopCount 0 94: set frm "normal" 95: set uom "" 96: while {![eof $fileId]} { 97: gets $fileId ln 98: set cmd [string toupper [lindex $ln 0]] 99: if {$Verbose>=2 && $cmd != ""} { puts "$cmd [lrange $ln 1 end]" } 100: switch -- $cmd { 101: "COLR" { 102: set nv [ParseYN [lindex $ln 1]] 103: if {$Colord==-1} { set Colord $nv } 104: if {$Verbose>=2} { puts " Setting colorized output to $nv (Colord==$Colord)." } 105: } 106: "FRMT" { 107: set frm [lindex $ln 1] 108: if {$Verbose>=2} { puts " Changed format to \"$frm\"" } 109: } 110: "UNIT" { 111: set uom [lindex $ln 1] 112: if {$Verbose>=2} { puts " Changed unit of measurement to \"$uom\"" } 113: } 114: "FINL" { 115: set fnl [lindex $ln 1];set mulv [lindex $ln 2] 116: if {$Verbose>=2} { puts " Final conversion is in unit \"$fnl\", found by multiplying by $mulv" } 117: } 118: "SLEN" { 119: set stocklength [lindex $ln 1] 120: if {$Verbose>=2} { puts " Changed the length of a unit of stock to $stocklength" } 121: } 122: "VERS" { 123: set ANSIFVER [lindex $ln 1] 124: set FVER [lindex $ln 2] 125: if {$Verbose>=2} { puts " Read version of file ($FVER)" } 126: } 127: "CHCK" { 128: set checkfile [lindex $ln 1] 129: if {$Verbose>=2} { puts " Checking for newer version in $checkfile." } 130: if {[file exists $checkfile]} { 131: set chcId [open $checkfile r] 132: set Found 0 133: set chkVer 0 134: while {![eof $chcId] && !$Found} { 135: gets $chcId ln 136: if {[string toupper [lindex $ln 0]] == "VERS"} { set chkVer [lindex $ln 2] ; set Found 1 } 137: } 138: close $chcId 139: if {$Verbose>=2} { puts " Version $chkVer found (vs $FVER)." } 140: if {$chkVer>$FVER} { 141: if {$Verbose!=0} { puts "Switching to updated file, $checkfile. \t\[$FVER->$chkVer\]" } 142: close $fileId ; set fileId [open $checkfile r] 143: } 144: } 145: } 146: "CHOP" { 147: set choplen [lindex $ln 1] 148: set chopcnt [lindex $ln 2] 149: if {$chopcnt==""} { set chopcnt 1 } 150: incr ChopCount $chopcnt 151: if {![info exists StocksArray($choplen)]} { 152: set StocksArray($choplen) $chopcnt 153: if {$Verbose>=2} { puts " New stock length of $choplen added, quantity $chopcnt." } 154: } else { 155: incr StocksArray($choplen) $chopcnt 156: if {$Verbose>=2} { puts " Added $chopcnt more lengths of $choplen, total of $StocksArray($choplen)" } 157: } 158: } 159: } 160: } 161: if {$CheckVerExit && [info exists FVER]} { puts "$ANSIFVER: v$FVER." } 162: if {$CheckVerExit} { exit } 163: if {$Colord==1} { 164: set r "\033\[0m";set cr "$r\033\[0;31m";set cg "$r\033\[0;32m";set cb "$r\033\[0;34m" 165: set cm "$r\033\[0;35m";set cc "$r\033\[0;36m";set cw "$r\033\[0;37m";set bw "$r\033\[0;38m" 166: set bb "$r\033\[1;30m";set br "$r\033\[1;31m";set bg "$r\033\[1;32m";set by "$r\033\[1;33m";set cy $by 167: set bl "$r\033\[1;34m";set bc "$r\033\[1;36m" 168: } else { 169: set r "";set cr "";set cg "";set cb "";set cm "";set cc "";set cw "";set cy "" 170: set bb "";set bw "";set br "";set bg "";set by "";set bl "";set bc "" 171: } 172: # now lets figure this out.. 173: set choplens [array names StocksArray] 174: set chopcnts [expr [llength $choplens]-1] 175: if {$SLEN!=0} { set stocklength $SLEN } 176: foreach ele $choplens { 177: if {$ele>$stocklength} { 178: puts "\033\[1;37;44mNOTE: \033\[0m" 179: puts "A block has been requested that is longer than the length of stock($ele$uom>$stocklength$uom)." 180: unset StocksArray($ele) 181: set choplens [array names StocksArray] 182: } else { 183: set UsedStock($ele) 0 184: set EvalUsedStock($ele) 0 185: set UsedStock($ele.max) [expr int($stocklength / $ele)] 186: } 187: } 188: if {$choplens==""} { puts "No cuts to be made. Terminating." ; exit } 189: set allstockused 0 190: set done 0 191: set loopcounter 0 192: set Nearest 0 193: set UseBestMatch 0 194: set PiecesNeeded 0 195: puts -nonewline "Analyzing..." 196: set startseconds [clock seconds] 197: set startclicks [clock clicks] 198: flush stdout 199: while {!$allstockused} { 200: incr loopcounter 201: set cnt -1;set done 0 202: while {!$done} { 203: if {![info exists cnt]} { set cnt 0 } else { incr cnt } 204: set lcc [lindex $choplens $cnt] 205: if {$lcc==""} { set lcc [lindex $choplens 0] ; set done 1 ; set UseBestMatch 1} 206: set tmpVal $EvalUsedStock($lcc) 207: incr tmpVal 208: if {$tmpVal > [ReturnSmallest $UsedStock($lcc.max) [expr $StocksArray($lcc)-$UsedStock($lcc)]]} { set EvalUsedStock($lcc) 0 } else { set EvalUsedStock($lcc) $tmpVal ; set done 1 } 209: } 210: set OutLen 0 211: foreach ele $choplens { 212: set OutLen [expr $OutLen+($EvalUsedStock($ele)*$ele)] 213: } 214: if {$Verbose>=2} { 215: puts "Tried combination resulting in a total usage of $OutLen$uom" 216: foreach ele $choplens { puts "$ele - $EvalUsedStock($ele)" } 217: } 218: if {$OutLen<$stocklength && $OutLen>$Nearest} { 219: set Nearest $OutLen 220: foreach ele $choplens { set BestMatch($ele) $EvalUsedStock($ele) } 221: if {$Verbose>=2} { 222: puts "New closest match, $OutLen" 223: foreach ele $choplens { puts "$ele - $EvalUsedStock($ele)" } 224: } 225: } 226: if {$UseBestMatch} { 227: set OutLen 0 228: foreach ele $choplens { set EvalUsedStock($ele) $BestMatch($ele) ; set OutLen [expr $OutLen+($ele*$BestMatch($ele))] } 229: } 230: if {$OutLen==$stocklength || $UseBestMatch} { 231: foreach ele $choplens { 232: set OutArray($PiecesNeeded.$ele) $EvalUsedStock($ele) 233: incr UsedStock($ele) $EvalUsedStock($ele) 234: } 235: if {$Verbose!=0} { 236: puts "Match ($OutLen).. adding to used materials" 237: foreach ele $choplens { puts "$ele - $EvalUsedStock($ele)" } 238: } 239: foreach ele $choplens { set EvalUsedStock($ele) 0;set BestMatch($ele) 0 } 240: set Nearest 0 241: set UseBestMatch 0 242: incr PiecesNeeded 243: } 244: set allstockused 1 245: foreach ele $choplens { 246: if {$UsedStock($ele)!=$StocksArray($ele)} { set allstockused 0 } 247: } 248: } 249: set doneclicks [clock clicks] 250: set doneseconds [clock seconds] 251: set clicktime [expr ($doneclicks-$startclicks)/1000000.00000] 252: set secondtime [expr ($doneseconds-$startseconds)] 253: if {$clicktime>0} { set calctime $secondtime } else { set calctime $clicktime } 254: puts "done. Total time $calctime seconds." 255: puts "$PiecesNeeded piece[CheckS $PiecesNeeded] of stock with a length of $stocklength$uom will be needed." 256: set ou "" 257: if {$RealFormat != ""} { set frm $RealFormat } 258: if {[string tolower $frm] == "normal" || [string tolower $frm] == "long" || [string tolower $frm]=="medium"} { puts -nonewline "$cr\Numbe$bb";puts "r\t$bw\Quant.\t$cg\Lengt$bg\h$r" } else { puts "Number" } 259: 260: set Formats(SHORT) {$bw$NumPieces$r piece[CheckS $NumPieces] of $bg$ele$cg$uom$ou$extra, } 261: #0=all,1 non-zero's,2=zeros 262: set Formats(SHORT.freq) 1 263: set Formats(NORMAL) {\t$r$bw$NumPieces$r\t$cg$ele$bg$uom$ou$r$extra\n } 264: set Formats(NORMAL.freq) 1 265: set Formats(MEDIUM.freq) 1 266: set Formats(MEDIUM) {\t$r$bw$NumPieces$r[string trim $extra][ifnull $extra "\t" ""]$cg$ele$bg$uom$ou$r\n } 267: set Formats(LONG) {\t$bw$NumPieces $cy-$r\t$bg$ele$cg$uom$ou$extra\n } 268: set Formats(LONG.freq) 0 269: set TotalWaste 0 270: for {set i 0} {$i <$PiecesNeeded} {incr i} { 271: set extra "" 272: set TotalOut "" 273: puts -nonewline "$cr[expr $i +1]$bb)$r " 274: set OutLen 0 275: foreach ele $choplens { 276: set OutLen [expr $OutLen+($ele*$OutArray($i.$ele))] 277: set NumPieces $OutArray($i.$ele) 278: if {[info exists fnl]} { set ou " $bc\($cc[expr $ele*$mulv]$bw$fnl$r$bc\)$r" } 279: set mmc [string toupper $frm] 280: set ff $Formats($mmc.freq) 281: if {($ff==0) || ($ff==1 && $NumPieces!=0) || ($ff==2 && $NumPieces==0)} { set TotalOut "$TotalOut[subst $Formats($mmc)]" } 282: } 283: if {!$NoWaste} { 284: set NumPieces 1 285: set ele [expr $stocklength-$OutLen] 286: set TotalWaste [expr $TotalWaste+$ele] 287: if {[info exists fnl]} { set ou " $bc\($cc[expr $ele*$mulv]$bw$fnl$bc\)$r" } 288: set extra " $bb\[$bl\waste$bb\]$r" 289: set TotalOut "$TotalOut[subst $Formats($mmc)]" 290: } 291: puts "[string range $TotalOut 0 [expr [string length $TotalOut]-3]]" 292: } 293: if {!$NoWaste} { puts "Total Waste is $cg$TotalWaste$bg$uom$r" } chopstock.tcl is a Tcl script I wrote to determine the best way to chop multiple pieces of fixed length material (linear material usage analysis). |