mexmr10 Posted January 31, 2010 Share Posted January 31, 2010 Can anyone modify the following lisp for me? I found it on cadalyst and its almost what I need, but I would like a little more functionality. Here's how it works: 1) I have a block, that I use as a label, named key-plant and it has 2 attributes: planttype and quantity. "Planttype" is the symbol/code that represents a certain plant species and "quantity" is the quantity that I assign to a group of certain plant blocks. 2.) I use this "key-plant" block with a leader and label all of my plant blocks. 3.) I run it typing "pll" and it gives me a plant list in a notepad document...example shown below: PLANT-TYPE QUANTITY AM ............. 19 CS .............170 PA ...............4 PCA ..............2 VL ...............78 cas ..............490 Here are my questions/requests: 1.) The lisp currently just throws together a comprehensive list of all blocks in the drawing. I want to add one more attribute like - "Category" - to the "key-plant" block so that I can organize the plant list by the following plant categories: -Deciduous Shade Trees -Ornamental Trees -Evergreen Trees -Deciduous Shrubs -Evergreen Shrubs -Perennials and Ornamental Grasses 2.) I'd like the list to output in that order (shown above) and then alphabetize for each category. 3.) I'd like to output to an excel file instead of a notepad file. Can anyone help me with this? I know this is very specific, but It would really make my work a lot more efficient. There are so many gurus here and I'm a total noob to Lisp code. This is what the "ideal" output would look like: PLANT-TYPE QUANTITY Deciduous Shade Trees AM .................19 CS .................170 Ornamental Trees APB .................4 BN ...................78 Evergreen Trees PA................... 490 PGD ................. 25 etc...etc... plant-list.LSP Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 31, 2010 Share Posted January 31, 2010 I wrote this a while back, untested, but give it a go: ;; Summing Attributes Before Extraction ;; By Lee McDonnell (defun c:AttSum (/ ss ofile file attlst x y lst) (vl-load-com) (if (and (setq ss (ssget "_X" '((0 . "INSERT") (2 . "KEY-PLANT") (66 . 1)))) (setq file (getfiled "Output File" "" "csv" 9))) (progn (setq ofile (open file "a")) (write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")) ofile) (write-line "ITEM,QUANTITY" ofile) (setq attlst (mapcar (function (lambda (x) (mapcar (function vla-get-TextString) x))) (mapcar (function (lambda (x) (vl-sort x (function (lambda (x1 x2) (< (vla-get-TagString x1) (vla-get-TagString x2))))))) (mapcar (function (lambda (x) (vlax-safearray->list (vlax-variant-value (vla-getAttributes x))))) (mapcar (function vlax-ename->vla-object) (mapcar (function cadr) (ssnamex ss))))))) (while (setq x (car attlst)) (if (setq y (assoc (car x) lst)) (setq lst (subst (append y (cdr x)) y lst)) (setq lst (cons x lst))) (setq attlst (cdr attlst))) (foreach x lst (write-line (strcat (car x) (chr 44) (rtos (apply (function +) (mapcar (function distof) (cdr x))))) ofile)) (write-line "-----,-----" ofile) (close ofile)) (princ "\n<!> No Blocks Found <!>")) (princ)) Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Works great but..... can you make it organize/alphabetize the excel output based on a third attribute named "category" ? Thanks for your help Lee. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Perhaps. Would you be able to upload an example of the block you are using? Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Sure...give me 2 minutes. Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 oops...completely forgot the last 4 categories (groundcovers, vines, annuals, seed mixes) So the final excel output should have the following categories in the following order and alphabetized per category. -Deciduous Shade Trees -Ornamental Trees -Evergreen Trees -Deciduous Shrubs -Evergreen Shrubs -Perennials and Ornamental Grasses -Groundcovers -Vines -Annuals and Bulbs -Seed Mixes One last request....Would it be possible to get a selection set prompt so I can selectively choose which blocks I'd like to get this info from? Could I use a polyline boundary for this selection set.? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Didn't see your last request, but try this for the first part: ;; Summing Attributes Before Extraction (defun c:AttSum (/ *error* Get_Unique ATTLST CAT CAT_TAG ENT FILE I N NUM NUM_TAG OBJ OFILE SS SYM SYM_TAG) (vl-load-com) ;; Lee Mac ~ 01.02.10 (setq Cat_Tag "CATEGORY" Sym_Tag "SYMBOL" Num_Tag "QUANTITY") (defun *error* (msg) (and ofile (close ofile)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Get_Unique (lst / Remove_n x ass result) (defun Remove_n (n lst) (setq i -1) (vl-remove-if (function (lambda (x) (= (setq i (1+ i)) n))) lst)) (while (setq x (car lst)) (setq lst (cdr lst)) (while (setq ass (assoc (car x) lst)) (setq x (cons (car x) (append (cdr x) (cdr ass)))) (setq lst (Remove_n (vl-position ass lst) lst))) (setq result (cons x result))) result) (mapcar (function set) '(Cat_Tag Sym_Tag Num_Tag) (mapcar (function strcase) (list Cat_Tag Sym_Tag Num_Tag))) (if (and (setq i -1 ss (ssget '((0 . "INSERT") (2 . "KEY-PLANT") (66 . 1)))) (setq file (getfiled "Output File" "" "csv" 9))) (progn (setq ofile (open file "a")) (write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")) ofile) (write-line "PLANT-TYPE,QUANTITY" ofile) (while (setq ent (ssname ss (setq i (1+ i)))) (setq obj (vlax-ename->vla-object ent)) (foreach att (vlax-invoke obj 'GetAttributes) (cond ( (eq Cat_Tag (strcase (vla-get-TagString att))) (setq Cat (vla-get-TextString att))) ( (eq Sym_Tag (strcase (vla-get-TagString att))) (setq Sym (vla-get-TextString att))) ( (eq Num_Tag (strcase (vla-get-TagString att))) (setq Num (vla-get-TextString att))))) (if (and Cat Sym Num) (setq AttLst (cons (cons Cat (list (cons Sym (list Num)))) AttLst)))) (setq AttLst (vl-sort (mapcar (function (lambda (x) (cons (car x) (vl-sort (Get_Unique (cdr x)) (function (lambda (a b) (< (car a) (car b)))))))) (Get_Unique AttLst)) (function (lambda (a b) (< (car a) (car b)))))) (foreach x Attlst (write-line (car x) ofile) (foreach y (cdr x) (write-line (strcat (car y) (chr 44) (rtos (apply (function +) (mapcar (function distof) (cdr y))))) ofile)) (write-line "" ofile)) (setq ofile (close ofile))) (princ "\n<!> No Blocks Found <!>")) (princ)) EDIT: Updated as per last request Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 This is almost dead on...You sir are a genius! The category names showed up alphabetized, but I need them in this specific order: -Deciduous Shade Trees -Ornamental Trees -Evergreen Trees -Deciduous Shrubs -Evergreen Shrubs -Perennials and Ornamental Grasses -Groundcovers -Vines -Annuals and Bulbs -Seed Mixes What I need alphabetized is the content in each category. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 This is almost dead on...You sir are a genius! The category names showed up alphabetized, but I need them in this specific order: -Deciduous Shade Trees -Ornamental Trees -Evergreen Trees -Deciduous Shrubs -Evergreen Shrubs -Perennials and Ornamental Grasses -Groundcovers -Vines -Annuals and Bulbs -Seed Mixes What I need alphabetized is the content in each category. You don't ask for much... :wink: Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Im sorry...and I really appreciate your help. Ok would it work if I inserted a number in front of each category name so that it would read the number first instead of the first letter? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Im sorry...and I really appreciate your help. Ok would it work if I inserted a number in front of each category name so that it would read the number first instead of the first letter? I'm not saying I can't make what you want, just takes a bit of re-jigging... One drawback of using this method, if an attribute category appears in the drawing and doesn't appear in your list of categories, then it won't be written. Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 I understand but i think thats ok though...I dont have any other categories that I use. Those are it. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Give this a shot: Newer Code Below.... Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Actually, this should account for that other case also: ;; Summing Attributes Before Extraction (defun c:AttSum (/ *error* Get_Unique ATTLST CAT CATS CAT_TAG ENT FILE I N NEWATTLST NEWORDER NUM NUM_TAG OBJ OFILE ORD SS SYM SYM_TAG) (vl-load-com) ;; Lee Mac ~ 01.02.10 ;; ----------<< Attribute Tag Names >>---------- (setq Cat_Tag "CATEGORY" Sym_Tag "SYMBOL" Num_Tag "QUANTITY") ;; ----------<< Attribute Tag Order >>---------- (setq Ord '("Deciduous Shade Trees" "Ornamental Trees" "Evergreen Trees" "Deciduous Shrubs" "Evergreen Shrubs" "Perennials and Ornamental Grasses" "Groundcovers" "Vines" "Annuals and Bulbs" "Seed Mixes" )) ;; --------------------------------------------- (defun *error* (msg) (and ofile (close ofile)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Get_Unique (lst / Remove_n x ass result) (defun Remove_n (n lst) (setq i -1) (vl-remove-if (function (lambda (x) (= (setq i (1+ i)) n))) lst)) (while (setq x (car lst)) (setq lst (cdr lst)) (while (setq ass (assoc (car x) lst)) (setq x (cons (car x) (append (cdr x) (cdr ass)))) (setq lst (Remove_n (vl-position ass lst) lst))) (setq result (cons x result))) result) (mapcar (function set) '(Cat_Tag Sym_Tag Num_Tag) (mapcar (function strcase) (list Cat_Tag Sym_Tag Num_Tag))) (setq Ord (mapcar (function strcase) Ord)) (if (and (setq i -1 ss (ssget '((0 . "INSERT") (2 . "KEY-PLANT") (66 . 1)))) (setq file (getfiled "Output File" "" "csv" 9)) (setq ofile (open file "a"))) (progn (write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")) ofile) (write-line "PLANT-TYPE,QUANTITY" ofile) (while (setq ent (ssname ss (setq i (1+ i)))) (setq obj (vlax-ename->vla-object ent)) (foreach att (vlax-invoke obj 'GetAttributes) (cond ( (eq Cat_Tag (strcase (vla-get-TagString att))) (setq Cat (vla-get-TextString att))) ( (eq Sym_Tag (strcase (vla-get-TagString att))) (setq Sym (vla-get-TextString att))) ( (eq Num_Tag (strcase (vla-get-TagString att))) (setq Num (vla-get-TextString att))))) (if (and Cat Sym Num) (setq AttLst (cons (cons Cat (list (cons Sym (list Num)))) AttLst)))) (setq AttLst (mapcar (function (lambda (x) (cons (car x) (vl-sort (Get_Unique (cdr x)) (function (lambda (a b) (< (car a) (car b)))))))) (Get_Unique AttLst))) (setq Cats (mapcar (function (lambda (x) (strcase (car x)))) AttLst)) (setq Ord (vl-remove-if-not (function (lambda (x) (vl-position x Cats))) Ord)) (setq newOrder (vl-remove 'nil (mapcar (function (lambda (x) (vl-position x Cats))) Ord))) (setq NewAttLst (mapcar (function (lambda (x) (nth x AttLst))) newOrder)) (setq AttLst (append NewAttLst (vl-remove-if (function (lambda (x) (vl-position x NewAttLst))) AttLst))) (foreach x Attlst (write-line (car x) ofile) (foreach y (cdr x) (write-line (strcat (car y) (chr 44) (rtos (apply (function +) (mapcar (function distof) (cdr y))))) ofile)) (write-line "" ofile)) (setq ofile (close ofile))) (princ "\n<!> No Blocks Found <!>")) (princ)) Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Works like a charm! Thanks for all of your help. Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Actually, this should account for that other case also: ;; Summing Attributes Before Extraction (defun c:AttSum (/ *error* Get_Unique ATTLST CAT CATS CAT_TAG ENT FILE I N NEWATTLST NEWORDER NUM NUM_TAG OBJ OFILE ORD SS SYM SYM_TAG) (vl-load-com) ;; Lee Mac ~ 01.02.10 ;; ----------<< Attribute Tag Names >>---------- (setq Cat_Tag "CATEGORY" Sym_Tag "SYMBOL" Num_Tag "QUANTITY") ;; ----------<< Attribute Tag Order >>---------- (setq Ord '("Deciduous Shade Trees" "Ornamental Trees" "Evergreen Trees" "Deciduous Shrubs" "Evergreen Shrubs" "Perennials and Ornamental Grasses" "Groundcovers" "Vines" "Annuals and Bulbs" "Seed Mixes" )) ;; --------------------------------------------- (defun *error* (msg) (and ofile (close ofile)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Get_Unique (lst / Remove_n x ass result) (defun Remove_n (n lst) (setq i -1) (vl-remove-if (function (lambda (x) (= (setq i (1+ i)) n))) lst)) (while (setq x (car lst)) (setq lst (cdr lst)) (while (setq ass (assoc (car x) lst)) (setq x (cons (car x) (append (cdr x) (cdr ass)))) (setq lst (Remove_n (vl-position ass lst) lst))) (setq result (cons x result))) result) (mapcar (function set) '(Cat_Tag Sym_Tag Num_Tag) (mapcar (function strcase) (list Cat_Tag Sym_Tag Num_Tag))) (setq Ord (mapcar (function strcase) Ord)) (if (and (setq i -1 ss (ssget '((0 . "INSERT") (2 . "KEY-PLANT") (66 . 1)))) (setq file (getfiled "Output File" "" "csv" 9)) (setq ofile (open file "a"))) (progn (write-line (strcat (getvar "DWGPREFIX") (getvar "DWGNAME")) ofile) (write-line "PLANT-TYPE,QUANTITY" ofile) (while (setq ent (ssname ss (setq i (1+ i)))) (setq obj (vlax-ename->vla-object ent)) (foreach att (vlax-invoke obj 'GetAttributes) (cond ( (eq Cat_Tag (strcase (vla-get-TagString att))) (setq Cat (vla-get-TextString att))) ( (eq Sym_Tag (strcase (vla-get-TagString att))) (setq Sym (vla-get-TextString att))) ( (eq Num_Tag (strcase (vla-get-TagString att))) (setq Num (vla-get-TextString att))))) (if (and Cat Sym Num) (setq AttLst (cons (cons Cat (list (cons Sym (list Num)))) AttLst)))) (setq AttLst (mapcar (function (lambda (x) (cons (car x) (vl-sort (Get_Unique (cdr x)) (function (lambda (a b) (< (car a) (car b)))))))) (Get_Unique AttLst))) (setq Cats (mapcar (function (lambda (x) (strcase (car x)))) AttLst)) (setq Ord (vl-remove-if-not (function (lambda (x) (vl-position x Cats))) Ord)) (setq newOrder (vl-remove 'nil (mapcar (function (lambda (x) (vl-position x Cats))) Ord))) (setq NewAttLst (mapcar (function (lambda (x) (nth x AttLst))) newOrder)) (setq AttLst (append NewAttLst (vl-remove-if (function (lambda (x) (vl-position x NewAttLst))) AttLst))) (foreach x Attlst (write-line (car x) ofile) (foreach y (cdr x) (write-line (strcat (car y) (chr 44) (rtos (apply (function +) (mapcar (function distof) (cdr y))))) ofile)) (write-line "" ofile)) (setq ofile (close ofile))) (princ "\n<!> No Blocks Found <!>")) (princ)) Wait what is the "other case" ? Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 Lee - I need to add more attributes to my "key-plant" block so I can extract more info: I need to add the following attributes to the excel output in consecutive columns after symbol and quantity: Botanic Name.........Common Name...........Size...........Remarks Can you make the lisp file read/output those tags as well? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Wait what is the "other case" ? The case in which there is a category in the drawing and not appearing in the list. Lee - I need to add more attributes to my "key-plant" block so I can extract more info: I need to add the following attributes to the excel output in consecutive columns after symbol and quantity: Botanic Name.........Common Name...........Size...........Remarks Can you make the lisp file read/output those tags as well? Will have to see, don't have much time atm Quote Link to comment Share on other sites More sharing options...
mexmr10 Posted February 1, 2010 Author Share Posted February 1, 2010 The case in which there is a category in the drawing and not appearing in the list. Will have to see, don't have much time atm Ok...whenever you have time is ok. Question....would it be too much of a pain to have the excel output land in certain columns of an excel file that already has formatting---a "template" file? Is this even possible with lisp? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 1, 2010 Share Posted February 1, 2010 Ok...whenever you have time is ok. Question....would it be too much of a pain to have the excel output land in certain columns of an excel file that already has formatting---a "template" file? Is this even possible with lisp? At this point I am only writing to CSV, writing to Excel takes a bit more code, but yes, it can be done. Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.