Author Topic: Material Takeoff Routine Needed.  (Read 13101 times)

0 Members and 1 Guest are viewing this topic.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #30 on: January 23, 2009, 05:38:48 PM »
Ok so I've spent my day reading online about auto lisp, and visual lisp and have made very little progress.  I feel dumber now than ever :ugly:

However, I did figure a way to tailor the lisp that cab gave me in-order that it would calculate the separate members each by their selves. 

Now I just need to fix a few things in the lisp.  I have been testing it on several very simple frame drawings so that easily check to see if the computation it gives is correct.  I have found that it will sometimes call for extra cuts that are not needed and sometimes it will also call for 2 lengths when the drop would have been plenty to get the other cut.  I will include a dwg for illustration.

The only change I made was to the grouping as you explained.
Code: [Select]
;;  MaterialTakeOff.lsp
;;  CAB @ TheSwamp.org
;;  Version 1.0 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:matFrame2 (/ laylst ss MaxLen ent elst i result lay MasterList cutlst lst
                   oddlst tmp len)
  (vl-load-com)
  ;;  Layers are grouped by like material
  (setq laylst '("head" "int. horizontal" "sill" "Jamb" "int. vertical"))
  ;;  this is the stock length of the material in inches
  (setq MaxLen (* 12 24.0)) ; 24 feet
  (setq *debugmat* nil) ; turn debug mode OFF   *************

  (princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
  (princ "\nVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV")
  ;;  gather the materials from current space, only LINES matching the layers!
  (foreach lay laylst
    (if (setq ss (ssget "_X" (list (cons 8 lay) '(0 . "LINE")(cons 410 (getvar "ctab")))))
      (progn ; process the objects
        (and *debugmat* (print "SS count ")(princ (sslength ss)))
        (setq i -1
              cutlst nil)
        ;;  get the lengths only
        (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)
            (setq cutlst (cons len cutlst))
            (princ) ; debug
          )
        )
        (and *debugmat* (print "Raw list count ")(princ (length cutlst)))
        ;;  need to eliminate douplicate lines so only one line per section
        ;;  first sort by length
        (setq cutlst (vl-sort cutlst '<))
        (setq lst nil)
        (while (setq tmp (car cutlst)) ; eliminate douplicate
          (setq lst (cons tmp lst))
          (if (equal tmp (cadr cutlst) 0.001)
            (setq cutlst (cddr cutlst))    ; remove 2
            (setq oddlst (cons tmp oddlst) ; save odd length
                  cutlst (cdr cutlst))     ; remove 1
          )
        )
        (and *debugmat* (print "Pair remove count ")(princ (length lst)))
        (and oddlst (print "Odd lengths ")(princ oddlst))
        ;;  get the actual cutlist
        (setq MasterList (cons (list lay (setq tmp (get_cutlist lst maxlen))) MasterList))
        ;;  report to the command line the layer group & # of pieces needed
        (print lay)
        (print "Number of Lengths ")(princ (length tmp))
        (print "cutlst ")(princ tmp)
        (print "Drops")
        (mapcar '(lambda(x) (print (- MaxLen (apply '+ x)))) tmp)
               
      ) ; progn
    )
    (print)
  )
  (princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
  (textscr)
  (princ)
)
(princ "\nMaterial TakeOff loaded. Enter MatFrame to run.")
(princ)



;;  CAB 03/10/06
;;  updated 12/27/06
;;  updated 01/22/09
(defun get_cutlist (lst maxlen / cutlst itm lst 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
  (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
        ((> 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)
          lst (reverse lst)
    )
  )
  (if cutlst
    (cons cutlst finallst) ; add the last odd length
    finallst
  )
)
can you help me fix it please//  If you copy the frame once or twice and then run the lisp you will see that sometimes it sees duplicates and sometimes it doesn't also sometimes it won't use the drop/
« Last Edit: January 23, 2009, 06:00:09 PM by JCutrona »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #31 on: January 23, 2009, 06:18:11 PM »
Try the updated version.
I changed the layer groups & the max length & fixed the bug in the cutlist routine.

<edit: old code removed >
« Last Edit: January 28, 2009, 07:26:52 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #32 on: January 24, 2009, 10:10:00 PM »
I am very grateful sir, that you would help this much.

I can't wait to get to work monday and try it.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #33 on: January 26, 2009, 12:11:17 AM »
Let us know how it turns out.

I'm still digging out from a computer crash so I may be slow to respond for a day or two. :)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #34 on: January 26, 2009, 10:40:15 AM »
Looks perfect so far.  I am wondering though what the "ss count" and "raw count" stand for?  Is the raw count prior to deletion of duplicates?  That would make sense.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #35 on: January 26, 2009, 10:51:43 AM »
They are there for debugging.
Change this line
(setq *debugmat* t) ; debug mode nil=OFF t=On  *************
to this
(setq *debugmat* nil) ; debug mode nil=OFF t=On  *************
This will turn off the debug information at the command prompt.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #36 on: January 26, 2009, 03:01:17 PM »
Ok it is working perfect, however I need to increase the history on my the command line text window.  It is not going back far enough for this routine. Does anyone know how to do that?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #37 on: January 26, 2009, 04:34:12 PM »
Well try this. Adds Mtext to DWG.

<edit: old code removed >
« Last Edit: January 28, 2009, 07:26:11 PM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #38 on: January 28, 2009, 05:05:28 PM »
I have found some problems in my lsp file and hope someone can help me correct them.
I am very much enjoying the power and convenience of using auto lisp but am still  novice to the writing of it.
Any one who can help me will be greatly appreciated.

I am attaching a dwg which illustrates the 3 issues.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #39 on: January 28, 2009, 06:10:27 PM »
here is another simple example and the code I am using....

Please help.  (humbled and in anguish)

Code: [Select]
;;  MaterialTakeOff.lsp
;;  CAB @ TheSwamp.org
;;  Version 1.1 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:matFrame4 (/ laylst ss MaxLen ent elst i result lay MasterList cutlst lst
                   oddlst tmp len TextOut mtextobj space)
  (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)
  )
)
  ;;  Layers are grouped by like material
  (setq laylst '("head" "jamb" "sill" "int. horizontal" "int. vertical" "ssg int. vertical"))
  ;;  this is the stock length of the material in inches
  (setq MaxLen 285) ; Usable length of material
  (setq textOut "") ; text to add to the DEWG as Mtext
  (setq *MatMtextOut* t)
  (setq *debugmat* nil) ; turn debug mode OFF   *************

  (princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
  (princ "\nVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV")
  (and *debugmat* (princ "\nMaxLen = ")(princ MaxLen))
  ;;  gather the materials from current space, only LINES matching the layers!
  (foreach lay laylst
    (if (setq ss (ssget "_X" (list (cons 8 lay) '(0 . "LINE")(cons 410 (getvar "ctab")))))
      (progn ; process the objects
        (and *debugmat* (print "SS count ")(princ (sslength ss)))
        (setq i -1
              cutlst nil)
        ;;  get the lengths only
        (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)
            (setq cutlst (cons len cutlst))
            (princ) ; debug
          )
        )
        (and *debugmat* (print "Raw list count ")(princ (length cutlst)))
        ;;  need to eliminate douplicate lines so only one line per section
        ;;  first sort by length
        (setq cutlst (vl-sort cutlst '<))
        (setq lst nil)
        (while (setq tmp (car cutlst)) ; eliminate douplicate
          (setq lst (cons tmp lst))
          (if (equal tmp (cadr cutlst) 0.001)
            (setq cutlst (cddr cutlst))    ; remove 2
            (setq oddlst (cons tmp oddlst) ; save odd length
                  cutlst (cdr cutlst))     ; remove 1
          )
        )
        (and *debugmat* (print "Pair remove count ")(princ (length lst)))
        ;;(and oddlst (print "Odd lengths ")(princ oddlst))
        ;;  get the actual cutlist
        (setq MasterList (cons (list lay (setq tmp (get_cutlist lst maxlen))) MasterList))
        ;;  report to the command line the layer group & # of pieces needed
        (print lay)
        (print "Number of Lengths ")(princ (length tmp))
        (print "cutlst ")(princ tmp)
        (print "Drops")
        (mapcar '(lambda(x) (print (- MaxLen (apply '+ x)))) tmp)
        ;;  Gather text in a string  >>>>>>>>>>>>>>>>
        (setq textOut
               (strcat TextOut
                  (vl-princ-to-string "=-=-=-=-=-=-=-=-=-=-=-=-=-=\\P")
                  (vl-princ-to-string lay) "\\P"
                  "Number of Lengths "
                  (vl-princ-to-string (length tmp)) "\\P"
                  (if oddlst
                    (strcat "Odd lengths " (vl-princ-to-string oddlst) "\\P")
                    ""
                  )
                  "cutlst " (vl-princ-to-string tmp) "\\P"
                  "Drops" "\\P"
                       )
              )
        (mapcar '(lambda(x)
                   (setq textOut
                          (strcat TextOut
                                  (vl-princ-to-string (- MaxLen (apply '+ x)))
                                  "\\P"))) tmp)
        ;;  <<<<<<<<<<<<<<<<<<<<<<<
      ) ; progn
    )
  )
  (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
          (vla-put-layer mtextobj "G-Anno-Nplt")
          (vla-put-height mtextobj 5.0)
        )
      )
    )
  )
  (princ)
)
(princ "\nMaterial TakeOff loaded. Enter MatFrame to run.")
(princ)



;;  CAB 03/10/06
;;  updated 12/27/06
;;  updated 01/22/09
(defun get_cutlist (lst maxlen / cutlst itm lst 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
  (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
        ((> 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)
          lst (reverse lst)
    )
  )
  (if cutlst
    (cons cutlst finallst) ; add the last odd length
    finallst
  )
)

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #40 on: January 28, 2009, 07:24:55 PM »
This lisp should correct the problem with the count.

As for the tapered window, I will need to devise a differant detection method.

Code: [Select]
;;  MaterialTakeOff.lsp
;;  CAB @ TheSwamp.org
;;  Version 1.1a 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)
  (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)
  )
)
  ;;  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 textOut "") ; text to add to the DWG as Mtext
  (setq *MatMtextOut* t)
  (setq *debugmat* t) ; turn debug mode OFF   *************

  (princ "\n=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-")
  (princ "\nVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV")
  (and *debugmat* (princ "\nMaxLen = ")(princ MaxLen))
  ;;  gather the materials from current space, only LINES matching the layers!
  (foreach lay laylst
    (if (setq ss (ssget "_X" (list (cons 8 lay) '(0 . "LINE")(cons 410 (getvar "ctab")))))
      (progn ; process the objects
        (and *debugmat* (print "SS count ")(princ (sslength ss)))
        (setq i -1
              cutlst nil)
        ;;  get the lengths only
        (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)
            (setq cutlst (cons len cutlst))
            (princ) ; debug
          )
        )
        (and *debugmat* (princ "\nRaw list count ")(princ (length cutlst)))
        ;;  need to eliminate douplicate lines so only one line per section
        ;;  first sort by length
        (setq cutlst (vl-sort cutlst '<))
        (setq lst nil)
        (while (setq tmp (car cutlst)) ; eliminate douplicate
          (setq lst (cons tmp lst))
          (if (equal tmp (cadr cutlst) 0.001)
            (setq cutlst (cddr cutlst))    ; remove 2
            (setq oddlst (cons tmp oddlst) ; save odd length
                  cutlst (cdr cutlst))     ; remove 1
          )
        )
        (and *debugmat* (princ "\nPair remove count ")(princ (length lst)))
        ;;(and oddlst (print "Odd lengths ")(princ oddlst))
        ;;  get the actual cutlist
        (setq MasterList (cons (list lay (setq tmp (get_cutlist lst maxlen))) MasterList))
        ;;  report to the command line the layer group & # of pieces needed
        (print lay)
        (princ "\nNumber of Lengths ")(princ (length tmp))
        (princ "\nCutlst ")(princ tmp)
        (princ "\nDrops")
        (mapcar '(lambda(x) (print (- MaxLen (apply '+ x)))) tmp)
        ;;  Gather text in a string  >>>>>>>>>>>>>>>>
        (setq textOut
               (strcat TextOut
                  (vl-princ-to-string "=-=-=-=-=-=-=-=-=-=-=-=-=-=\\P")
                  (vl-princ-to-string lay) "\\P"
                  "Number of Lengths "
                  (vl-princ-to-string (length tmp)) "\\P"
                  (if oddlst
                    (strcat "Odd lengths " (vl-princ-to-string oddlst) "\\P")
                    ""
                  )
                  "cutlst " (vl-princ-to-string tmp) "\\P"
                  "Drops" "\\P"
                       )
              )
        (mapcar '(lambda(x)
                   (setq textOut
                          (strcat TextOut
                                  (vl-princ-to-string (- MaxLen (apply '+ x)))
                                  "\\P"))) tmp)
        ;;  <<<<<<<<<<<<<<<<<<<<<<<
      ) ; progn
    )
    (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
          (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/28/09
(defun get_cutlist (lst maxlen / cutlst itm lst 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)
  (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
        ((> 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)
          lst (reverse lst)
    )
  )
    (setq finallst (list lst))
  )
  ;(if cutlst
  ;  (cons cutlst finallst) ; add the last odd length
    finallst
  ;)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Ok, who's pro?
« Reply #41 on: January 28, 2009, 08:09:42 PM »
What would happen if I only make the outermost line "jamb" layer and leave the other one as something irrelevant?  Would that 'cause a problem since the routine is expecting a duplicate or would it work for my purposes?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #42 on: January 28, 2009, 08:58:52 PM »
That should work, they would be reported in the "Odd List Count".
But the material should be correct.
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Ok, who's pro?
« Reply #43 on: January 29, 2009, 07:02:08 PM »
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.
Code: [Select]
;;  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
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

JCUTRONA

  • Guest
Re: Material Takeoff Routine Needed.
« Reply #44 on: January 30, 2009, 08:56:45 AM »
Ok yeah, I will give it a try this morning. That should really help. 
And man...  Thanks all the more...  The longer I am around this community, the more I realize what a newbie (luser) I have been.  I have displayed some real ignorance of the etiquette of this culture.  Not to mention showed how technically un-educated I am.  I truly appreciate your patience and help despite these facts.  That kind of grace towards my error drives me now to try ever harder.