[编程交流] 总结Pa的具体数据

;;-----------------=={ 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)

;;-----------------=={ 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)