[编程交流] 统计属性值

(defun c:test (/ no)
 ;; Tharwat 30.9.2015        ;;
 (setq no 0)
 (vlax-for lay (vla-get-layouts
                 (vla-get-activedocument (vlax-get-acad-object))
               )
   (vlax-for spc (vla-get-block lay)
     (if (and (eq (vla-get-objectname spc) "AcDbBlockReference")
              (eq (vla-get-effectivename spc) "DOOR TAG")
              (eq (vla-get-hasattributes spc) :vlax-true)
              (vl-some '(lambda (x)
                          (and (eq (vla-get-tagstring x) "XF")
                               (eq (vla-get-textstring x) "D06")
                          )
                        )
                       (vlax-invoke spc 'getattributes)
              )
         )
       (setq no (1+ no))
     )
   )
 )
(princ (if (< 0 no) (strcat "\nNumber of Blocks < " (itoa no) " > .") "\nZero found !"))
 (princ)
)(vl-load-com)

(vl-load-com) 
(defun c:blocknum ( / bname tagname )
(setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
(setq bname (strcase (getstring "\nEnter block name")))
(setq tagname (strcase (getstring "\nEnter Block tag")))
(vlax-for block (vla-get-blocks adoc) 
(if (= (strcase (vla-get-name block)) bname) 
(progn
  (foreach att block 'getattributes)
       (if (= tagname (strcase (vla-get-tagstring att)))
       (setq x (+ 1x)) 
       )
   )
) ; progn
) ;_ end of if
) ;_ end of vlax-for block
(alert (strcat blockname " has " (rtos x 2 0) "with tag " tagname))
(princ) 
) ;-end of defun
(princ) 

(defun c:countattblocks ( / blk ent enx idx rtn sel tag val )
   (while
       (not
           (or
               (= "" (setq blk (strcase (getstring t "\nSpecify block name: "))))
               (tblsearch "block" blk)
           )
       )
       (princ (strcat "\nBlock " blk " not found."))
   )
   (if (and (/= "" blk) (setq tag (strcase (getstring "\nSpecify attribute tag: "))))
       (progn
           (setq val (strcase (getstring t "\nSpecify attribute value: "))
                 rtn 0
           )
           (if 
               (and
                   (setq sel
                       (ssget "_X" 
                           (list 
                              '(00 . "INSERT")
                              '(66 . 1)
                               (cons 02 (strcat "`*U*," blk))
                               (if (= 1 (getvar 'cvport))
                                   (cons 410 (getvar 'ctab))
                                  '(410 . "Model")
                               )
                           )
                       )
                   )
                   (progn
                       (repeat (setq idx (sslength sel))
                           (setq ent (ssname sel (setq idx (1- idx))))
                           (if (= blk (strcase (LM:name->effectivename (cdr (assoc 2 (entget ent))))))
                               (progn
                                   (setq ent (entnext ent)
                                         enx (entget  ent)
                                   )
                                   (while
                                       (and (= "ATTRIB" (cdr (assoc 0 enx)))
                                           (not
                                               (and
                                                   (= tag (strcase (cdr (assoc 2 enx))))
                                                   (= val (strcase (cdr (assoc 1 enx))))
                                                   (setq rtn (1+ rtn))
                                               )
                                           )
                                       )
                                       (setq ent (entnext ent)
                                             enx (entget  ent)
                                       )
                                   )
                               )
                           )
                       )
                       (< 0 rtn)
                   )
               )
               (princ
                   (strcat 
                       "\nFound " (itoa rtn) " " blk " block" (if (= 1 rtn) "" "s")
                       " with attribute tag " tag " with value " val "."
                   )
               )
               (princ (strcat "\nNo " blk " blocks found with attribute tag " tag " with value " val "."))
           )
       )
   )
   (princ)
)
;; Block Name -> Effective Block Name  -  Lee Mac
;; blk - [str] Block name
(defun LM:name->effectivename ( blk / rep )
   (if
       (and (wcmatch blk "`**")
           (setq rep
               (cdadr
                   (assoc -3
                       (entget
                           (cdr (assoc 330 (entget (tblobjname "block" blk))))
                          '("AcDbBlockRepBTag")
                       )
                   )
               )
           )
           (setq rep (handent (cdr (assoc 1005 rep))))
       )
       (cdr (assoc 2 (entget rep)))
       blk
   )
)
(princ)