wimal Posted September 30, 2015 Share Posted September 30, 2015 Block name DOOR TAG Tag XF Value D06 How can I count no of blocks which have above values. Quote Link to comment Share on other sites More sharing options...
Tharwat Posted September 30, 2015 Share Posted September 30, 2015 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) Quote Link to comment Share on other sites More sharing options...
BIGAL Posted September 30, 2015 Share Posted September 30, 2015 (edited) 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 October 1, 2015 by BIGAL Quote Link to comment Share on other sites More sharing options...
stevesfr Posted September 30, 2015 Share Posted September 30, 2015 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 ? Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 30, 2015 Share Posted September 30, 2015 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) Quote Link to comment Share on other sites More sharing options...
stevesfr Posted September 30, 2015 Share Posted September 30, 2015 absolutely, positively NEAT !! thx Lee Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted September 30, 2015 Share Posted September 30, 2015 absolutely, positively NEAT !! thx Lee Thank you Steve Quote Link to comment Share on other sites More sharing options...
BIGAL Posted October 1, 2015 Share Posted October 1, 2015 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. Quote Link to comment Share on other sites More sharing options...
danglar Posted October 6, 2015 Share Posted October 6, 2015 Is it possible to make a block and an attribute selection by click? probably this option will be more efficient? Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.