Jump to content

Counts attribute values


wimal

Recommended Posts

Try this:

 

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

Link to comment
Share on other sites

Bit rough not tested could be done way better, not tested

 


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

Edited by BIGAL
Link to comment
Share on other sites

Bit rough not tested could be done way better, not tested

 


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

 

What is the purpose of the * ?? Is this lisp intended for a block with only one tag ? I tried it on a block with two tags and can't get it to work ?

Link to comment
Share on other sites

Here is a generic program to count attributed blocks with a given tag/value, using only Vanilla AutoLISP for compatibility on a Mac:

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

Link to comment
Share on other sites

Sorry guys something went screwy when I pasted and some extra characters came through not sure why though.

 

Tharwat you must have posted seconds in front of me, I would not have posted.

 

 

Lee top of the class as usual.

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