TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: JCUTRONA on January 21, 2009, 10:05:57 AM
-
I work for a glass and glazing company doing shop drawings. I need to find a LISP file or command series that will help me find square footage and another one that will help me do materials "take offs" (count lineal feet of verticals/ horizontals/ heads/ sills ect.) My drawings are usually simple window elevations and substrate details.
If I could easily perform these tasks with ACAD somehow I would probably get a raise and a promotion immediately and be hailed as king till at-least Friday. If anyone can help me with this I will be forever indebted to them.
Thanks
-
I moved your request here, it will see more action in this forum. 8-)
-
Hmmm .... indebted forever? I have some grass that needs to be cut and some painting to be done :twisted:
-
Hmmm .... indebted forever? I have some grass that needs to be cut and some painting to be done :twisted:
Great idea ! :kewl:
-
What company products are you doing shop drawings for?
EFCO, Kawnaeer, etc?
-
KAWNEER 451T AND KAWNEER 1600 WALL FOR THIS PARTICULAR JOB.
-
I moved your request here, it will see more action in this forum. 8-)
THANKS.
-
You can start with these routines,
http://www.theswamp.org/index.php?topic=5891.0
http://www.theswamp.org/index.php?topic=1303.0
Be more specific about your needs.
-
This might help too.
http://www.theswamp.org/index.php?topic=20345.0
-
KAWNEER 451T AND KAWNEER 1600 WALL FOR THIS PARTICULAR JOB.
Sorry, I have some tools but I work for a competitor of Kawneer!
-
Please post a sample DWG with a window or two & perhaps a copy of those two with a detail showing how the materials are tabulated.
That would go a long way toward explaining your process.
Lisp is usually written in VLIDE which is accessed when you type that at the command line.
To load a lisp type appload at the command line & navigate to the file.
You should copy the lisp from the web & paste it into notepad or VLIDE and save as a .lsp file.
If you have the file in VLIDE you can load it from there. VLIDE is not needed to run a lisp that is
already loaded. To run a lisp you enter the function name. Look for this:
(defun c:mylisp (
in the lisp file.
You would enter mylisp at the command line.
HTH
-
KAWNEER 451T AND KAWNEER 1600 WALL FOR THIS PARTICULAR JOB.
Sorry, I have some tools but I work for a competitor of Kawneer!
Ok so whenever we work with you guys again can you help jared and I?
-
Here is an example file.
-
HTH
Thanks... This has helped tremendously already.
-
You can start with these routines,
http://www.theswamp.org/index.php?topic=5891.0
http://www.theswamp.org/index.php?topic=1303.0
Be more specific about your needs.
Now, would it be possible to take the length routine and alter it so that after i go through and pick each intermediate horizontal for example, it would give me a count of how many 24' stock lengths i would need instead of giving me a total of lineal feet.
I understand that if it is possible it would be a matter of writing the code correctly. I also understand that this takes valuable time so I don't expect you to do it for me. I'm just curious if it is possible.
and if it is how difficult it would be.
-
After reviewing your DWG I see no help from layer to determine the parts of the window.
At this point I would propose the following:
For glass area & seals & perhaps some fasteners you could use a 'Rectangle Pick' function.
The user would pick two diagonal corners to get area and perimeter for calculating.
The the user would enter how many of this same size to calculate.
A text memo would be placed within the rectangle with the count & maybe the info and
this info would be added to an internal list.
Another routine would allow the user to select via keyword which type frame element
[heads, sills, jambs, intermediate verticals, intermediate horizontals] and the select a
line representing the element for length. Then enter the number of like elements.
Again the routine would add text to the DWG at the line selected as a memo.
Also the master list would be updated.
The user would run a routine to print or output this master list to a file.
The lisp could also tabulate fasteners etc based on the lengths & types of elements.
Would that suite your current method of takeoff operation?
We would need formulas for fasteners. i.e. fasteners per inch or per foot
Also any add needed to get the correct glass size.
-
All very interesting. You must know you have made my day. Just the "length" lsp is a great help.
The glass sizes usually follow a formula that takes the width and height of the opening (day light opening) and adds either 1 inch or 3/4 of an inch to each dimension. For example, if the opening was 20"x10" the glass would be 21"x11" for curtain wall applications. The fasteners are usually bought in bulk any way so that is the least of my concerns. same with anchors really. Quantity of stock lengths of each type vertical and horizontal member and the glass unit sizes are the main objectives.
If I went back after the original drawings were done and changed all sills to a layer, all jambs to a layer and so on, could a lsp file tell me how many 24' stock lengths of each to order? That would be amazing. If a simple length lsp could give me the amount of 24' stock lengths and leftover "drops" that would be simply amazing. It wouldn't even have to know which type member they were necessarily.
-
Yes, probably so. Would need to look at the sample DWG.
-
ok here it is in layers. What are my options now?
-
That simplifies things.
I'll have some time tomorrow.
-
If you are looking for something a bit more elaborate (and you have money to spend), there is a commercial application out there that is supposed to be prety good for this type of thing:
http://www.gmtecsoft.com/home.aspx
-
Tied up most of the day and had Tennis this evening so I was Short on time.
This is what I came up with, works with example2.dwg posted above and I am relying on you to do the testing. :)
Bear in mind that this is the first draft. 8-)
Note:
I am using two layer groups: "head,jamb,sill" and "int. horizontal,int. vertical"
The material max. length is set at 24 feet.
;; 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:matFrame (/ 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,jamb,sill" "int. horizontal,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
)
)
-
Ok wow. I was busy yesterday too but I got it copied this morning and will give it a try.
My immediate confusion however is this, why are the heads, sills, jambs grouped? In a great deal of applications those would be different materials so I would need a seperate count for each.
Also how hard would it be to make the max length like 285 inches instead of 24 feet? That is usually the usable length after you cut the anodizing tong marks.
Any way wow, I am gonna go try it now. Thanks again
-
Out for several hours. :oops:
-
Nice! Very nice! I am beside myself. This is what dreams are made of.
A couple of questions how does this work? When I am ready to try this on a different drawing what do I need to do? Is it a matter of naming the layers exactly as they are in "example2.dwg"? Is that what the lisp recognizes ,the layer name? How does it compute? And is there a way where I can run this routine separately for each frame, like select the a whole frame and then type the command. Also can we divide the groups so that the function is run separately on heads, then on jambs, then on sills, then int. verticals, then on int horizontals, ect.
-
Nice! Very nice! I am beside myself. This is what dreams are made of.
A couple of questions how does this work? ...
:-D
Sorry too much caffeine...carry on.
-
:-D
Sorry too much caffeine...carry on.
Hey take it easy on the new guy would ya? I'm anxious to learn?... I'll be glad when I can laugh at in-experience?
-
Sorry...I meant no offense towards you. I was not laughing at the questions you asked, I was laughing at the "this is what dreams are made of" directly followed with "how does this work?" :-P
-
Yeah that probably was pretty funny huh? And no offense taken sir.
-
You're quite welcome. There are may programmers here that can do this sort of thing.
As you can see LISP is a powerful tool. :)
I this this will answer most if not all the questions you posted.
The max length of material is set as follows:
(setq MaxLen (* 12 24.0)) ; 24 feet
You could replace the line with this:
(setq MaxLen 285)
The lisp uses layer names to help gather the needed information. If another drawing follows this
layer naming convention then this routine will work on them as well.
The lisp gathers LINES on the layer groups like this:
(setq laylst '("head,jamb,sill" "int. horizontal,int. vertical"))
The layers may be separated like this:
(setq laylst '("head" "jamb" "sill" "int. horizontal" "int. vertical"))
The reason I grouped them together is that I thought they were the same material.
The routine creates a selection set of LINES matching each layer group, the layer group may
containing only one layer. Then it does the following:
ignore lines < 3" as this is an end of section line
eliminate duplicate lines, IE remove one from each pair of matching length lines
report any lines that did not have a matching pair, but keeps it in the list to be calculated.
The cut list are created in an older subroutine I had & updated to use in this situation.
Then the Drops are calculated.
The report to the command line can also be directed to a text file as well.
-
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.
;; 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/
-
Try the updated version.
I changed the layer groups & the max length & fixed the bug in the cutlist routine.
<edit: old code removed >
-
I am very grateful sir, that you would help this much.
I can't wait to get to work monday and try it.
-
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. :)
-
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.
-
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.
-
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?
-
Well try this. Adds Mtext to DWG.
<edit: old code removed >
-
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.
-
here is another simple example and the code I am using....
Please help. (humbled and in anguish)
;; 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
)
)
-
This lisp should correct the problem with the count.
As for the tapered window, I will need to devise a differant detection method.
;; 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
;)
)
-
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?
-
That should work, they would be reported in the "Odd List Count".
But the material should be correct.
-
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
)
-
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.
-
"midpoints < 6 units apart"<<<< This is brilliant. Wouldn't have thought of that for years, and if I had, would not been able to write it for more years. I am impressed sir.
-
We give newbies extra latitude. :)
Usually we teach LISP so you can create and fix your own routine but this one is too complex for
a first time lisper for sure.
AS for learning LISP it is usualy a steap learning curve if you have never programed before but only
moderate if you have background. I would say 3 month to a year before you are walking with LISP.:)
It all depends on your staring level & the amount of time you apply to study & practice.
To get off the ground in a hurry you should read from these sites:
Start at the beginning http://www.afralisp.net/
http://jefferypsanders.com/autolisp.html
http://ronleigh.info/autolisp/index.htm
http://usa.autodesk.com/adsk/servlet/item?siteID=123112&id=770225
Intermediate to Advanced:
http://pages.cs.wisc.edu/~vernon/cs367/notes/6.RECURSION.html
Advanced:
http://www.atablex.com/htmls/excel-bible.htm
http://www.steinvb.net/vldb/
http://www.caddigest.com/subjects/autocad/tutorials/select/parsai_vlx.htm
References:
http://www.hyperpics.com/commands/index.asp
http://www.autodesk.com/techpubs/autocad/acad2000/dxf/
Extra credit:
http://www.analogx.com/contents/articles/howtoprg.htm
http://www.paulgraham.com/progbot.html
http://www.dreamsongs.com/SeatBelts.html
http://www.dreamsongs.com/ArtOfLisp.html
That's all I have time for this morning.
My advice, start small & let you routine grow with your abilities.
There is plenty of help here at TheSwamp just for the asking? :)
-
"midpoints < 6 units apart"<<<< This is brilliant. Wouldn't have thought of that for years, and if I had, would not been able to write it for more years. I am impressed sir.
Thanks you Sir.
Not infallible but given that we are dealing with specific layers I opted not to test for parallel lines
which would be a safety feature. 8-)
-
The Jeff Sanders stuff is VERY easily understood. Even for a first timer... Progressing now.
-
That's a pretty good reading list Alan.
-
Thanks Kerry.
It will keep most beginners busy for quite some time. 8-)
-
I found these links too but have not explored them.
Link to pdf Lessons:
http://forums.augi.com/showpost.php?p=190406&postcount=21
14 lessons by Dave Pitzer
http://usa.autodesk.com/adsk/servlet/item?siteID=123112&id=2309147
follow the link at the bottom of each lesson
Free AutoLisp course
http://forums.augi.com/attachment.php?attachmentid=3425&d=1093637254