Sorry but the Odd List was not included in the previous routine.
This is a major revision in that you may now select the individual window(s) to get totals from.
The totals are combined in the output. Note that the angled window should also work.
As before please test as my time has been limited these few days.
;; MaterialTakeOff.lsp
;; CAB @ TheSwamp.org
;; Version 1.2 beta
;;
;; From layer groups in this routine compute a cutlist based on a max length
;; of raw material. Output the list to the command line along with the length
;; of each drop (waste material) Enter MatFrame to run
;;***********************************
;; PLEASE TEST BEFORE ACTUAL USE
;;***********************************
(defun c:matFrame (/ laylst ss MaxLen ent elst i result lay MasterList cutlst lst oddlst tmp len
TextOut mtextobj space laygroups
)
(vl-load-com)
(defun activespace (doc)
(if (or (= acmodelspace (vla-get-activespace doc)) (= :vlax-true (vla-get-mspace doc)))
(vla-get-modelspace doc)
(vla-get-paperspace doc)
)
)
;; return the mid point
(defun GetMidPoint (el)
(mapcar '(lambda (a b) (/ (+ a b) 2.)) (cdr (assoc 10 el)) (cdr (assoc 11 el)))
)
;; Create a Layer
(defun makelay (LName LColor LType)
(if (not(tblsearch "LAYER" LName))
(entmakex (list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 LName) ;layer name
(cons 6 (if (and ltype(tblobjname "ltype" ltype)) ltype "Continuous")) ;linetype
(cons 62 LColor) ;layer color
'(70 . 0) ; on, unlocked, thawed
)
)
)
)
;; CAB 12/27/2006
;; (RemoveNth 3 '(0 1 2 3 4 5))
;; (0 1 2 4 5)
(defun removeNth (i lst)
(setq i (1+ i))
(vl-remove-if '(lambda(x) (zerop (setq i (1- i)))) lst)
)
;;============================================================
;; Layers are grouped by like material
(setq laylst '("head" "jamb" "sill" "int. horizontal" "int. vertical"))
;; this is the stock length of the material in inches
(setq MaxLen 285) ; Usable length of material
(setq *debugmat* t) ; debug mode nil=OFF t=On *************
(setq textOut "") ; text to add to the DEWG as Mtext
(setq *MatMtextOut* t)
(setq layFilter "") ; combine the layers
(mapcar '(lambda (x) (setq layFilter (strcat layFilter x ","))) laylst)
(prompt "\nSelect window(s) for cutlist.")
(if (setq ss (ssget (list (cons 8 layfilter) '(0 . "LINE"))))
(progn
;; seperate ss into lists by layers
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq elst (entget ent))
;; ignore < 3" as this is an end of section line
(if (> (setq len (distance (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))) 3.0)
(progn
;; list = ((<layerName> (<length> <midpoint>) (<length> <midpoint>) )
;; (<layerName> (<length> <midpoint>) (<length> <midpoint>) )
;; )
(cond
((null laygroups)
(setq laygroups (list (list (cdr (assoc 8 elst)) (list len (GetMidPoint elst)))))
)
((setq tmp (assoc (cdr (assoc 8 elst)) laygroups)) ; group already in list
(setq laygroups
(subst
(append tmp (list (list len (GetMidPoint elst))))
tmp
laygroups
)
)
)
(t ; new layer to group
(setq laygroups (cons (list (cdr (assoc 8 elst)) (list len (GetMidPoint elst)))
laygroups
)
)
)
)
)
)
)
(princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
(princ "\nVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV")
(and *debugmat* (princ "\nMaxLen = ") (princ MaxLen))
;; gather the materials from current space, only LINES matching the layers!
(foreach Lgroup laygroups
(setq Layname (car Lgroup)
cutlst (cdr Lgroup)
)
(and *debugmat*
(princ (strcat "\nCount for Layer " Layname " "))
(princ (length Lgroup))
)
;; sort by length of line
(setq cutlst (vl-sort cutlst '(lambda (l1 l2) (< (car l1) (car l2)))))
;; need to eliminate douplicate lines so only one line per section
;; first sort by length
(setq lst nil
oddlst nil)
(while (setq tmp (car cutlst)) ; eliminate douplicate
(if (equal (car tmp) (car (cadr cutlst)) 0.001)
(setq lst (cons tmp lst)
cutlst (cddr cutlst)) ; remove 2
(setq oddlst (cons tmp oddlst) ; save to odd length
cutlst (cdr cutlst)
) ; remove 1
)
)
(setq cutlst lst lst nil)
;; check odd lengths for match [ midpoints < 6 units apart]
(and oddlst (princ "\n Number of Odd lengths ") (princ oddlst))
(setq i (length oddlst))
(while (> (setq i (1- i)) 0)
(setq i2 (1- i)
pt (cadr (nth i oddlst))
)
(while
(cond
((< i2 0) nil) ; exit inner, nothing to compare
((< (distance pt (cadr (nth i2 oddlst))) 6.0)
(if (< (car (nth i oddlst)) (car (nth i2 oddlst)))
(setq oddlst (removeNth i oddlst))
(setq oddlst (removeNth i2 oddlst))
)
(setq i (1- i)
i2 (1- i2)
)
nil ; exit inner loop
)
)
)
)
(and oddlst (setq cutlst (append oddlst cutlst)))
(setq cutlst (mapcar 'car cutlst)) ; remove the points
;; get the actual cutlist
(setq MasterList (cons (list lay (setq tmp (get_cutlist cutlst maxlen))) MasterList))
;; report to the command line the layer group & # of pieces needed
(princ "\n>>> Part name - ")
(princ Layname)
(princ "\nNumber of Lengths ")
(princ (length tmp))
(princ "\nCutlst ")
(princ tmp)
(princ "\nNumber of cuts ")
(princ (length cutlst))
(princ "\nDrops")
(mapcar '(lambda (x) (print (- MaxLen (apply '+ x)))) tmp)
;; Gather text in a string >>>>>>>>>>>>>>>>
(setq textOut
(strcat TextOut
(vl-princ-to-string "=-=-=-=-=-=-=-=-=-=-=-=-=-=\\P")
"Part name " (vl-princ-to-string Layname) "\\P"
"Number of Lengths " (vl-princ-to-string (length tmp)) "\\P"
"Cutlst " (vl-princ-to-string tmp) "\\P"
"Number of cuts " (vl-princ-to-string (length cutlst)) "\\P"
"Drops\\P"
)
)
(mapcar '(lambda (x)
(setq textOut
(strcat TextOut
(vl-princ-to-string (- MaxLen (apply '+ x)))
"\\P"
)
)
)
tmp
)
) ; foreach
)
)
(print)
(princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
(if (and *MatMtextOut*
(/= TextOut "")
(setq pt (getpoint "\nPick point for text: "))
)
(progn
;; uses current text style & height, zero width mtext
(setq space (activespace (vla-get-activedocument (vlax-get-acad-object))))
(setq mtextobj (vl-catch-all-apply
'vla-addMText
(list space (vlax-3d-point (trans pt 1 0)) 0.0 textout)
)
)
(if (vl-catch-all-error-p mtextobj)
(prompt "\nERROR - Mtext Failed...")
(progn
(setq lyr (makelay "G-Anno-Nplt" 140 nil))
(and lyr (vla-put-plottable (vlax-ename->vla-object lyr :vlax-false)))
(and lyr (vlax-release-object (vlax-ename->vla-object lyr)))
(vla-put-layer mtextobj "G-Anno-Nplt")
(vla-put-height mtextobj 3.0)
)
)
)
)
(princ)
)
(princ "\nMaterial TakeOff loaded. Enter MatFrame to run.")
(princ)
;; CAB 03/10/06
;; updated 12/27/06
;; updated 01/22/09
;; updated 01/23/09
(defun get_cutlist (lst maxlen / cutlst itm ptr tl x finallst remove-at tmp tp)
;; (RemoveNth 3 '(0 1 2 3 4 5)) CAB 12/27/2006
(defun removeNth (i lst)
(setq i (1+ i))
(vl-remove-if '(lambda (x) (zerop (setq i (1- i)))) lst)
)
;; sort the list with largest first
(setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
;; catch any length over MaxLen & break them
(if (not (vl-every '(lambda (x) (<= x MaxLen)) lst))
(progn
(while (> (setq tmp (car lst)) MaxLen)
(setq lst (cdr (append lst (list MaxLen (- tmp MaxLen)))))
)
(setq lst (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst '>)))
)
)
;; step through lst
(if (= (length lst) 1)
(setq finallst (list lst))
(progn
(while lst
(setq cutlst (list (car lst)) ; start new cutlist w/ first item
lst (reverse (cdr lst)) ; remove first item
eol (1- (length lst)) ; point to end of list
tl (apply '+ cutlst) ; total length so far
ptr 0
)
;; build the cutlst
(while
(cond
((null lst) nil)
((> ptr eol) nil)
((< (+ (nth ptr lst) tl) MaxLen)
(setq cutlst (cons (nth ptr lst) cutlst)
tl (+ tl (car cutlst))
lst (removeNth ptr lst)
eol (1- eol)
)
)
((setq ptr (1+ ptr)))
)
)
;; no more cuts fit, go to next
(setq finallst (cons cutlst finallst)
cutlst nil
lst (reverse lst)
)
)
)
)
finallst
)