Jump to content

Modifying Plant Schedule Lisp. Please help.


mexmr10

Recommended Posts

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

Link to comment
Share on other sites

  • Replies 38
  • Created
  • Last Reply

Top Posters In This Topic

  • mexmr10

    12

  • Lee Mac

    11

  • One_Punchman

    9

  • Roy_043

    5

Top Posters In This Topic

Posted Images

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))

Link to comment
Share on other sites

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.?

Link to comment
Share on other sites

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 :)

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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:

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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))

Link to comment
Share on other sites

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" ?

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...