Jump to content

Summarize Specific Data for Particular Attributes in Dynamic Blocks


TheyCallMeJohn

Recommended Posts

Okay guys so here is what I am looking for, I want to write a lisp or modify an existing lisp, that will select blocks within a given selection frame and summarize the attribute data in table either in the drawing or an excel file.

 

I found LeeMac's awesome program "Count Attribute Values" but my issues is that for right now its still way over my head so I am having difficulties following much of it. Also I would like to limit it to blocks with a certain name(s) and then within that block only summarize one specific attribute because the blocks have a count attributes which isn't necessary.

 

If anyone can give me some guidance or something I can build off of it would be greatly appreciated.

 

Also I know EATTEXT can do this but I am looking for something substantially quicker.

Link to comment
Share on other sites

;;-----------------=={ Count Attribute Values }==-------------;;
;;                                                            ;;
;;  Counts the number of occurrences of attribute values in a ;;
;;  selection of attributed blocks. Displays result in an     ;;
;;  AutoCAD Table object.                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:CAV nil (c:CountAttributeValues))

(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes s ss i e alist bnlist attlist)
(setq bnlist '([color="blue"]"BN1" "BN2" "BN3"[/color]) [color="red"];; BLOCK NAME HERE[/color]
     attlist '([color="blue"]"ATT1" "ATT2" "ATT3" "ATT4"[/color]) [color="red"];; ATTRIBUTES HERE[/color]
)

 (defun _Dxf ( key alist ) (cdr (assoc key alist)))

 (defun _Assoc++ ( key alist )
   (
     (lambda ( pair )
       (if pair
         (subst (list key (1+ (cadr pair))) pair alist)
         (cons  (list key 1) alist)
       )
     )
     (assoc key alist)
   )
 )

 (defun _SumAttributes ( entity alist / eqlist)
   (while
     (not
       (eq "SEQEND"
         (_dxf 0
           (entget
             (setq entity
               (entnext entity)
             )
           )
         )
       )
     )
    (setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
   )
(setq alist  (vl-remove-if (function (lambda (a) (not (member (car a) attlist)))) alist))
 )

 (if 
   (setq s (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (setq ss (ssadd))     
     (repeat 
       (setq i (sslength s))
       (if 
         (member 
           (vla-get-effectivename 
             (vlax-ename->vla-object 
               (setq e 
                 (ssname s 
                   (setq i (1- i))
                 )
               )
             )
           ) 
           bnlist
         )
         (ssadd e ss))
     )
   
 (cond
   (
     (not
       (vlax-method-applicable-p
         (setq space
           (vlax-get-property
             (setq doc
               (vla-get-ActiveDocument (vlax-get-acad-object))
             )
             (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
           )
         )
         'AddTable
       )
     )

     (princ "\n** This Version of AutoCAD Does not Support Tables **")
   )
   (
     (and 
        (repeat (setq i (sslength ss))
        (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
        )
        (setq pt (getpoint "\nPick Point for Table: "))
     )
    
     (LM:AddTable space (trans pt 1 0) "Attribute Totals"
       (cons '("Value" "Total")
         (vl-sort
           (mapcar
             (function
               (lambda ( pair )
                 (list (car pair) (itoa (cadr pair)))
               )
             )
             alist
           )
           (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
         )
       )
     )
   )
 ))
)
 (princ)
)

;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

 (defun _itemp ( collection item )
   (if
     (not
       (vl-catch-all-error-p
         (setq item
           (vl-catch-all-apply 'vla-item (list collection item))
         )
       )
     )
     item
   )
 )

 (
   (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
     (
       (lambda ( row )
         (mapcar
           (function
             (lambda ( rowitem ) (setq row (1+ row))
               (
                 (lambda ( column )
                   (mapcar
                     (function
                       (lambda ( item )
                         (vla-SetText table row
                           (setq column (1+ column)) item
                         )
                       )
                     )
                     rowitem
                   )
                 )
                 -1
               )
             )
           )
           data
         )
       )
       0
     )
     table
   )
   (
     (lambda ( textheight )
       (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
         (* textheight
           (apply 'max
             (cons (/ (strlen title) (length (car data)))
               (mapcar 'strlen (apply 'append data))
             )
           )
         )
       )
     )
     (vla-getTextHeight
       (_itemp
         (_itemp
           (vla-get-Dictionaries
             (vla-get-ActiveDocument (vlax-get-acad-object))
           )
           "ACAD_TABLESTYLE"
         )
         (getvar 'CTABLESTYLE)
       )
       acDataRow
     )
   )
 )
)

(princ)

Edited by jdiala
Link to comment
Share on other sites

Thanks Jdiala,

Tried it a couple different ways and couldn't get it work. Doesn't error out just doesn't do anything after I select the objects. double checked that I had the right block name and attribute a couple times.

Link to comment
Share on other sites

I modified the code above.

 

Sorry Lee for messing up your code. Couldn't figure it out without using another selection set.

Link to comment
Share on other sites

Sorry, my bad. I thought you want to count attribute values.

try this one.

 


;;-----------------=={ Count Attribute Values }==-------------;;
;;                                                            ;;
;;  Counts the number of occurrences of attribute values in a ;;
;;  selection of attributed blocks. Displays result in an     ;;
;;  AutoCAD Table object.                                     ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:CAV nil (c:CountAttributeValues))

(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes s ss i e  bnlist alist att)
(setq bnlist '("KIT-ID" "KITID") ;; BLOCK NAME HERE
     att "XXXX" ;;; atribute here
) 

 (defun _Dxf ( key alist ) (cdr (assoc key alist)))

 (defun _Assoc++ ( key alist )
   (
     (lambda ( pair )
       (if pair
         (subst (list key (1+ (cadr pair))) pair alist)
         (cons  (list key 1) alist)
       )
     )
     (assoc key alist)
   )
 )
 (defun LM:vl-getattributes ( blk )
   (mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att)))
       (vlax-invoke blk 'getattributes)
   )
)
 (defun _SumAttributes ( entity alist)
   (while
     (not
       (eq "SEQEND"
         (_dxf 0
           (entget
             (setq entity
               (entnext entity)
             )
           )
         )
       )
     )
     (setq alist 
       (vl-remove-if 
         (function 
           (lambda (a)
             (and
               (not 
                 (= att 
                   (vla-get-tagstring 
                     (vlax-ename->vla-object entity)
                   )          
                 )
               )                                
               (eq  
                 (cdr 
                   (assoc 1
                     (entget entity)
                   )
                 ) 
                 (car a)
               )
             )
           )
         )   
         (_Assoc++ 
           (_Dxf 1 
             (reverse  
               (entget entity)
             )
           ) 
           alist
         )
       )  
     )
   )
 )

 (if 
   (setq s (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (setq ss (ssadd))     
     (repeat 
       (setq i (sslength s))
       (if 
         (member 
           (vla-get-effectivename 
             (vlax-ename->vla-object 
               (setq e 
                 (ssname s 
                   (setq i (1- i))
                 )
               )
             )
           ) 
           bnlist
         )
         (ssadd e ss))
     )
     
   
 (cond
   (
     (not
       (vlax-method-applicable-p
         (setq space
           (vlax-get-property
             (setq doc
               (vla-get-ActiveDocument (vlax-get-acad-object))
             )
             (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
           )
         )
         'AddTable
       )
     )

     (princ "\n** This Version of AutoCAD Does not Support Tables **")
   )
   (
     (and 
        (repeat (setq i (sslength ss))
        (setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
        )
        (setq pt (getpoint "\nPick Point for Table: "))
        (princ alist)
     )
    
     (LM:AddTable space (trans pt 1 0) "Attribute Totals"
       (cons '("Value" "Total")
         (vl-sort
           (mapcar
             (function
               (lambda ( pair )
                 (list (car pair) (itoa (cadr pair)))
               )
             )
             alist
           )
           (function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
         )
       )
     )
   )
 ))
)
 (princ)
)

;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

 (defun _itemp ( collection item )
   (if
     (not
       (vl-catch-all-error-p
         (setq item
           (vl-catch-all-apply 'vla-item (list collection item))
         )
       )
     )
     item
   )
 )

 (
   (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
     (
       (lambda ( row )
         (mapcar
           (function
             (lambda ( rowitem ) (setq row (1+ row))
               (
                 (lambda ( column )
                   (mapcar
                     (function
                       (lambda ( item )
                         (vla-SetText table row
                           (setq column (1+ column)) item
                         )
                       )
                     )
                     rowitem
                   )
                 )
                 -1
               )
             )
           )
           data
         )
       )
       0
     )
     table
   )
   (
     (lambda ( textheight )
       (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
         (* textheight
           (apply 'max
             (cons (/ (strlen title) (length (car data)))
               (mapcar 'strlen (apply 'append data))
             )
           )
         )
       )
     )
     (vla-getTextHeight
       (_itemp
         (_itemp
           (vla-get-Dictionaries
             (vla-get-ActiveDocument (vlax-get-acad-object))
           )
           "ACAD_TABLESTYLE"
         )
         (getvar 'CTABLESTYLE)
       )
       acDataRow
     )
   )
 )
)

(princ)

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