Text or Block Count

I was wondering if someone can help me locate a lisp routine which would enable me to count the number of a specific text or block.

For blocks: there is an express tool called BCOUNT

About the texts: do you have the same text in more place in the drawing area? Ore maybe you mean to search in all the (m)texts for a specific word?

For complicated text processing you could export all the texts from the drawing in a text file, open that file in a word processor and count for words as you need.

Here you will find lisp programs to export the text from drawings:

http://www.cadtutor.net/forum/showthread.php?t=79

I was wondering if someone can help me locate a lisp routine which would enable me to count the number of a specific text or block.

Dialogue function of calculation of ocurrences of text symbols in a file of the drawing

The author: Peter V. Loskutov

PL:WrdCount

Dialogue function of calculation of ocurrences of blocks in a file of the drawing

The author: Peter V. Loskutov

PL:BlCount

in Russia Hear

Loskutov.zip

Just written for block conunting.

(defun c:blc(/ blSet filLst nameLst curLen)

 (defun namesExtract(selSet)
   (mapcar '(lambda(x)(assoc 2 x))
    (mapcar 'entget(vl-remove-if 'listp
     (mapcar 'cadr(ssnamex selSet)))))
   ); end of namesExtract
 
 (princ "\n<<< Select sample blocks to count >>> ")
 (if(setq blSet(ssget '((0 . "INSERT"))))
   (progn
     (setq filLst(append(list '(0 . "INSERT"))(list '(-4 . "<OR"))
	     (namesExtract blSet)(list '(-4 . "OR>"))))
     (princ "\n<<< Specify area(s) to count >>> ")
      (if(setq blSet(ssget filLst))
 (progn
   (setq nameLst(namesExtract blSet))
   (princ "\n========== COUNT REPORT ==========")
   (while nameLst
     (setq curLen(length nameLst))
     (princ(strcat "\n" (cdar nameLst) " "
		  (itoa(- curLen(length(setq nameLst
		    (vl-remove(car nameLst)nameLst)))))))
     ); end while
   (princ "\n=========== END REPORT ===========\n")
   (textscr)
   ); end progn
 ); end if
     ); end progn
   ); end if
 (princ)
 ); end of c:blc

lisp routine which would enable me to count the number of a specific text...

What about _find command?

Look still here

6. Added WORDS.lsp to count words inside an autocad drawing

Just written for block conunting.

(defun c:blc(/ blSet filLst nameLst curLen)

 (defun namesExtract(selSet)
   (mapcar '(lambda(x)(assoc 2 x))
    (mapcar 'entget(vl-remove-if 'listp
     (mapcar 'cadr(ssnamex selSet)))))
   ); end of namesExtract

 (princ "\n<<< Select sample blocks to count >>> ")
 (if(setq blSet(ssget '((0 . "INSERT"))))
   (progn
     (setq filLst(append(list '(0 . "INSERT"))(list '(-4 . "<OR"))
            (namesExtract blSet)(list '(-4 . "OR>"))))
     (princ "\n<<< Specify area(s) to count >>> ")
      (if(setq blSet(ssget filLst))
    (progn
      (setq nameLst(namesExtract blSet))
      (princ "\n========== COUNT REPORT ==========")
      (while nameLst
        (setq curLen(length nameLst))
        (princ(strcat "\n" (cdar nameLst) " "
             (itoa(- curLen(length(setq nameLst
               (vl-remove(car nameLst)nameLst)))))))
        ); end while
      (princ "\n=========== END REPORT ===========\n")
      (textscr)
      ); end progn
    ); end if
     ); end progn
   ); end if
 (princ)
 ); end of c:blc

 

ASMI,

It doesn't seem to work for dynamic blocks? any ideas? Our company just switched over all our symbols to dynamic blocks.

Try it

(defun c:blockcount (/ adoc selset res name) 
 (vl-load-com) 
 (setq adoc (vla-get-activedocument (vlax-get-acad-object))) 
 (if (setq selset (ssget '((0 . "INSERT")))) 
   (progn 
     (foreach blk 
              (mapcar 'vlax-ename->vla-object 
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset))) 
                      ) ;_ end of mapcar 
       (setq name (cond 
                    ((and (vlax-property-available-p blk 'isdynamicblock) 
                          (= (vla-get-isdynamicblock blk) :vlax-true) 
                          ) ;_ end of and 
                     (vla-get-effectivename blk) 
                     ) 
                    (t (vla-get-name blk)) 
                    ) ;_ end of cond 
             ) ;_ end of setq 
       (if (member name (mapcar 'car res)) 
         (setq res (subst (cons name (1+ (cdr (assoc name res)))) 
                          (assoc name res) 
                          res 
                          ) ;_ end of subst 
               ) ;_ end of setq 
         (setq res (append res (list (cons name 1)))) 
         ) ;_ end of if 
       ) ;_ end of foreach 
     (princ "\nName\tCount") 
      
     (foreach item res 
       (princ (strcat "\n" (car item) "\t" (vl-princ-to-string (cdr item)))) 
       ) ;_ end of foreach 
     (princ) 
     ) ;_ end of progn 
   ) ;_ end of if 
 ) ;_ end of defun

Hi, Guys.

I am trying to get a block list with comma delimited format like:

block 1,block 2,refblock,

with a lisp in order to use it inside a lisp with the attsync command lis this

(command "attsync" "name" blocklist)

for a selection set or all the blocks in the drawing. Can someone help?

-------------------------

nevermind... I solved it with

(command "attsync" "name" *)

To answer your question of retrieving a comma-delimited block list, as it may be of benefit to others:

(setq str (car (ai_table "BLOCK" 0)))
(foreach x (cdr (ai_table "BLOCK" 0))
 (setq str (strcat str (chr 44) x)))

THANKS, I'll check it out in another time when I require it.

To answer your question of retrieving a comma-delimited block list, as it may be of benefit to others:

 

(setq str (car (ai_table "BLOCK" 0)))
(foreach x (cdr (ai_table "BLOCK" 0))
 (setq str (strcat str (chr 44) x)))

To answer your question of retrieving a comma-delimited block list, as it may be of benefit to others:

 

(setq str (car (ai_table "BLOCK" 0)))
(foreach x (cdr (ai_table "BLOCK" 0))
 (setq str (strcat str (chr 44) x)))

You know Lee...Now I think I will need this code to fix my own "Fix". I found myself fixing this routine because in my company we insert standard blocks by dimscale, so I fixed this routine before, but since we have standard attribute blocks, I needed them to syncronize back the selected attribute blocks after changing their scale. So I tried to add the attsync command at the end, but i am syncronizing all the blocks, and there are many adjusted that are being sincronized and I just want to sincronize previously selected blocks, (ssget)

The problem is that the attsync command just allows to select one block at a time.. or the comma delimited block name list, it must not have spaces in the list...

That why I asked for the comma delimited selected block list... but sincerely I don´t know how to merge the code you gave me in this lisp... Do you know how can it be done? I need to replace the attsync command line with the result of the list after your code gave me the list.

;;; BXY by David Harrington; Modified by Paulo Gil Soto (added annotation scale reset to 1:1)
;;; updates selected blocks x,y and z values to current Dimscale
;;;
;;; Main Program
;;;
(defun c:Bu (/ ss xs ys zs num x na lst editxyz_error olcmdecho old_err) 
(defun editxyz_error (msg) 
 (if (or
   (= msg "Function cancelled")
   (/= msg "quit / exit abort")
  ) 
  (princ (strcat "Error: " msg))
 ) 
 (command ".UNDO" "E" "UNDO" "") 
 (setq *error*  old_err
    old_err  nil
 )
 (setvar "CMDECHO" olcmdecho)
 (princ)
) 
(setq old_err *error* 
   olcmdecho (getvar "CMDECHO")
   *error* editxyz_error
) 
(setvar "CMDECHO" 0)
       (setq dms (getvar "dimscale"))
(command ".UNDO" "BE")  (prompt "\nSelect Blocks to match current dimscale: ")
(cond
 ((setq ss (ssget '((0 . "INSERT"))))
        (command "-objectscale" ss "" "add" "1:1" "" "cannoscale" "1:1") 
  (setq num (sslength ss))
  (setq x 0)
  (repeat num 
   (setq na (ssname ss x)) 
   (setq lst (entget na))
   (setq lst (subst (cons 41 dms) (assoc 41 lst) lst))
   (setq lst (subst (cons 42 dms) (assoc 42 lst) lst))
   (setq lst (subst (cons 43 dms) (assoc 43 lst) lst))
   (entmod lst) 
   (entupd na) 
   (setq x (+ x 1))
  )
 )
)
(command "attsync" "name" "*")
       (command ".UNDO" "E") 
(setq *error* old_err)
(setvar "CMDECHO" olcmdecho)
(princ)
)

Perhaps something like this?

(defun c:bu (/ *error* doc oldc ss sel)
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if oldc (setvar "CMDECHO" oldc))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
 (setvar "CMDECHO" 0)

 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-StartUndoMark doc)
     (command "_.-objectscale" ss "" "_add" "1:1" "")
     (setvar "CANNOSCALE" "1:1")
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (foreach x '(XScaleFactor YScaleFactor ZScaleFactor)
         (vlax-put-property Obj x scl))
       (command "_.attsync" "_Name" (vla-get-Name Obj)))
     (vla-delete sel)
     (vla-EndUndoMark doc)))

 (setvar "CMDECHO" oldc)
 (princ))

Perhaps something like this?

 

(defun c:bu (/ *error* doc oldc ss sel)
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if oldc (setvar "CMDECHO" oldc))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
 (setvar "CMDECHO" 0)

 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-StartUndoMark doc)
     (command "_.-objectscale" ss "" "_add" "1:1" "")
     (setvar "CANNOSCALE" "1:1")
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (foreach x '(XScaleFactor YScaleFactor ZScaleFactor)
         (vlax-put-property Obj x scl))
       (command "_.attsync" "_Name" (vla-get-Name Obj)))
     (vla-delete sel)
     (vla-EndUndoMark doc)))

 (setvar "CMDECHO" oldc)
 (princ))

yujuuuu.... excelent... you're da man..

It was to complex to accomplish for me....

I guess i will have to start learning lisp to the deepest...

but I really have found all I have been looking for years in just 2 weeks... And it is thanks to you and Alan J thompson and someone else in another forum... but you guys really really rock!!

thank you.

Perhaps something like this?

lee, you naughty boy, you forgot to localize all your variables. call it a fluke that i saw it.

(defun c:bu (/ *error* doc oldc ss sel [color=Red]scl[/color])
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if oldc (setvar "CMDECHO" oldc))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
 (setvar "CMDECHO" 0)

 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-StartUndoMark doc)
     (command "_.-objectscale" ss "" "_add" "1:1" "")
     (setvar "CANNOSCALE" "1:1")
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (foreach x '(XScaleFactor YScaleFactor ZScaleFactor)
         (vlax-put-property Obj x scl))
       (command "_.attsync" "_Name" (vla-get-Name Obj)))
     (vla-delete sel)
     (vla-EndUndoMark doc)))

 (setvar "CMDECHO" oldc)
 (princ))

lee, you naughty boy, you forgot to localize all your variables. call it a fluke that i saw it.

 

(defun c:bu (/ *error* doc oldc ss sel [color=red]scl[/color])
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if oldc (setvar "CMDECHO" oldc))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE"))
 (setvar "CMDECHO" 0)

 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-StartUndoMark doc)
     (command "_.-objectscale" ss "" "_add" "1:1" "")
     (setvar "CANNOSCALE" "1:1")
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (foreach x '(XScaleFactor YScaleFactor ZScaleFactor)
         (vlax-put-property Obj x scl))
       (command "_.attsync" "_Name" (vla-get-Name Obj)))
     (vla-delete sel)
     (vla-EndUndoMark doc)))

 (setvar "CMDECHO" oldc)
 (princ))

Taking a closer look, it seems that you re-made the entire lisp...

It would have been impossible for me, I took like a whole day to just add the objectscale, cannoscale and the attsync in the correct order... I know I am gonna pay for it someday... I will upload a gigantic block and detail collection in less than a month... mostly with 2d and 3d blocks, and some (about 10-15%) details, but those will be mostly for Spanish standards... I am getting everything available today in the web and organizing it. anyway.. thanks again and I will let you know when I am done with that.

GUESS what... It actually solved partially my problem... I tested it with some more blocks and some 'dynamic attribute blocks' started dissapearing... It's weird because the attribute value is there but it doesn´t show, only after another attsync they are back visible. i don't know what happens now.. I shouldn´t go back to the attsync all... so I guess I will try to learn a bit more about 'attsync' and 'block selection'.

try this attached if you wish to test

----

ok, I was thinking on my way home.. I thought that it wouldn´t matter if just model space blocks are all sincronized... but now I realize there is another partial solution, to sincronize by name "1*,2*,a*" and so on.. I wouldn´t care of sincronizing all block in the drawing but leaving off those starting with zero, so I will update my old version with this new row.... and that should work for the moment.

(command "attsync" "name" "1*,2*,3*,4*,5*,6*,7*,8*,9*,a*,b*,c*,d*,e*,f*,g*,h*,i*,j*,k*,l*,m*,n*,o*,p*,q*,r*,s*,t*,u*,v*,w*,x*,y*,z*")

And you know Lee... Your lisp version would helped us a lot before 2008, now we use some dynamic blocks (not because of me) and the problem is just with them, but your sincronizing selected blocks with attsync works perfect on normal blocks and normal attribute blocks.

check8.dwg

lee, you naughty boy, you forgot to localize all your variables. call it a fluke that i saw it.

Ahhh! Good spot mate

GUESS what... It actually solved partially my problem... I tested it with some more blocks and some 'dynamic attribute blocks' started dissapearing... It's weird because the attribute value is there but it doesn´t show, only after another attsync they are back visible. i don't know what happens now.. I shouldn´t go back to the attsync all... so I guess I will try to learn a bit more about 'attsync' and 'block selection'.

 

try this attached if you wish to test

 

----

ok, I was thinking on my way home.. I thought that it wouldn´t matter if just model space blocks are all sincronized... but now I realize there is another partial solution, to sincronize by name "1*,2*,a*" and so on.. I wouldn´t care of sincronizing all block in the drawing but leaving off those starting with zero, so I will update my old version with this new row.... and that should work for the moment.

 

(command "attsync" "name" "1*,2*,3*,4*,5*,6*,7*,8*,9*,a*,b*,c*,d*,e*,f*,g*,h*,i*,j*,k*,l*,m*,n*,o*,p*,q*,r*,s*,t*,u*,v*,w*,x*,y*,z*")

 

And you know Lee... Your lisp version would helped us a lot before 2008, now we use some dynamic blocks (not because of me) and the problem is just with them, but your sincronizing selected blocks with attsync works perfect on normal blocks and normal attribute blocks.

I'm glad I could help you gilsoto - but I'm afraid my knowledge of dynamic blocks is extremely limited indeed.. having never used them personally.

Another option, not sure whether you would get different results, would be to construct a comma delimited string of block names when iteration through the selection set, and pass this one string to attsync at the end of the function - instead of calling attsync each time. - But I am not sure that this would make any difference.

This would produce the comma delimited list of block names, worth a try

(defun c:bu (/ *error* doc oldc ss sel scl [b][color=Red]str[/color][/b])
 (vl-load-com)

 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if oldc (setvar "CMDECHO" oldc))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq doc (vla-get-ActiveDocument
             (vlax-get-acad-object)))
 (setq oldc (getvar "CMDECHO") scl (getvar "DIMSCALE") [b][color=Red]str ""[/color][/b])
 (setvar "CMDECHO" 0)

 (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
   (progn
     (vla-StartUndoMark doc)
     (command "_.-objectscale" ss "" "_add" "1:1" "")
     (setvar "CANNOSCALE" "1:1")
     (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet doc))
       (foreach x '(XScaleFactor YScaleFactor ZScaleFactor)
         (vlax-put-property Obj x scl))
       [b][color=Red](setq str (strcat str (vla-get-Name Obj) (chr 44)))) [/color][/b]       
     (vla-delete sel)
[b][color=Red]      (command "_.attsync" "_Name" (substr str 1 (1- (strlen str))))[/color][/b]
     (vla-EndUndoMark doc)))

 (setvar "CMDECHO" oldc)
 (princ))

Changes highlighted.

Well, It maybe produces the comma delimited list, since it sincronizes selected blocks only, and that's good, but even with this change, same problem comes up with those dynamic blocks.

Actually, they are tricky, because sometimes they lose their dynamic functions for unknown reasons, sometimes after scaling, sometimes after mirroring... but well... original bu.lsp works for scaling and it returns selected blocks to positive and just the attsync part is causing trouble...

Now you added the comma delimited format, I think I will try to merge it into my previous version that is working ok with those dynamic blocks... I will let you know.