Jump to content

count the number a given text letters e.g. 3No. H's


Recommended Posts

Posted

Hi,

Is there a way in getting AutoCAD 2010 to count the number a given text entity appears.

 

I specify an load of different standard columns all labelled with a letter and number. e.g. F9 or D4 ....etc. So i have lots of these and need to schedule them. Currently I print out the drawings and count them by hand. Very slow and laborious!

 

Other that put all combinations on a different layer which would take longer that counting them, is there a way round this.

 

Please help, all suggestions welcome.

 

Thanks

  • Replies 33
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    15

  • stockers

    8

  • laijumalias

    4

  • ReMark

    3

Posted

Please do not double post. It makes following the course of the discussion confusing and splits answers/suggestions over multiple threads. Try to be patient.

 

The BCOUNT command doesn't do what you want?

Posted

I wrote this as part of my TabSort routine:

 

(defun StrBrks (str / x slst nLst rLst aLst)
 
 (setq slst (vl-string->list str))
 
 (while (setq x (car slst))
   (setq slst (cdr slst))
   (cond (  (and nLst (= 46 x))
            (setq nLst (cons x nLst)))
         (  (< 47 x 58)
            (setq nLst (cons x nLst))
            (setq rLst (cons (reverse aLst) rLst) aLst nil))
         (t (setq aLst (cons x aLst))
            (setq rLst (cons (reverse nLst) rLst) nLst nil))))
 
 (mapcar 'vl-list->string
   (vl-remove nil
     (reverse
       (cons (reverse aLst)
         (cons (reverse nLst) rLst))))))

(defun Num_Extract (str)
 (mapcar 'read
   (vl-remove-if-not
     (function
       (lambda (x)
         (vl-position (type (read x)) '(INT REAL))))
     (StrBrks str))))

Example:

 

(Num_Extract "AB24n2i4tn4")
(24 2 4 4)

 

EDIT: Woww... completely mis-read the post...!

 

Well, hopefully this code will help someone :)

Posted

Quick one:

 

(defun c:tcnt (/ ss tStr)
 (vl-load-com)
 (if (and (setq ss (ssget "X" (list (cons 0 "*TEXT"))))
      (setq tStr (getstring t "\nText to Search For: ")))
   (progn
     (setq ss (vl-remove-if-not '(lambda (x) (eq tStr (cdr (assoc 1 (entget x)))))
        (mapcar 'cadr (ssnamex ss))))
     (if (not (zerop (length ss)))
   (princ (strcat (rtos (length ss) 2 0) " Item(s) Found."))
   (princ "\nNo Matching Text Strings. ")))
   (princ "\n<!> No Text Found in Drawing <!>"))
 (princ))

Case Sensitive

Posted

Actually, this is quicker:

 

(defun c:tcnt (/  i j ss tStr)

 (and (setq i -1 j 0 ss (ssget "_X" (list (cons 0 "TEXT,MTEXT"))))
      (setq tStr (getstring t "\nText to Search For: "))

      (while (setq ent (ssname ss (setq i (1+ i))))
        (if (eq tStr (cdr (assoc 1 (entget ent)))) (setq j (1+ j)) t))

      (princ (strcat "\n << " (itoa j) " Item(s) Found >>")))
 
 (princ))

Posted
Quick one:

 

(defun c:tcnt (/ ss tStr)
 (vl-load-com)
 (if (and (setq ss (ssget "X" (list (cons 0 "*TEXT"))))
      (setq tStr (getstring t "\nText to Search For: ")))
   (progn
     (setq ss (vl-remove-if-not '(lambda (x) (eq tStr (cdr (assoc 1 (entget x)))))
        (mapcar 'cadr (ssnamex ss))))
     (if (not (zerop (length ss)))
   (princ (strcat (rtos (length ss) 2 0) " Item(s) Found."))
   (princ "\nNo Matching Text Strings. ")))
   (princ "\n<!> No Text Found in Drawing <!>"))
 (princ))

Case Sensitive

 

 

Hi,

Sorry for the double post.

This is almost exactly what I am looking for thank you.

The only thing is it doesn't count text in a dynamic block.

Is this easy to add in?

Thanks.

Posted

Why didn't you mention that little detail (dynamic block) in the first place? It really helps to have all the information up front.

Posted
The only thing is it doesn't count text in a dynamic block.

Is this easy to add in?

 

Eeeek! Not really... only because I have limited experience with Dyn Blocks... :oops:

Posted

Ok, sorry I wasn't aware that it made a difference as I don't understand everything there is to know are autocad and lisp routines.

Posted
Eeeek! Not really... only because I have limited experience with Dyn Blocks... :oops:

 

No worries thanks.

I think I can get round it but copying all my dynamic block in model space and using the burst command. thanks what you gave me will really help.

Posted

Please consider changing your profile to reflect the software you actually use.

Posted

This may help a bit more...

 

I wrote this a while back for another request, and have just updated it to make it faster.

  • Select Text that you want to report on
  • The program will search the drawing and compile a report
  • Report is displayed in a Table

This code will also count text found in attributes, (but not sure about Dynamic Blocks).

 

(defun c:tsel (/ *error* unique BPT CATT CNT DOC ENT I ITM J
                     K LST OBJ OLST SPC SS TBLOBJ TSS UFLAG)
 
 ;; by Lee McDonnell (Lee Mac)
 
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun unique (lst / result)
   (reverse
     (while (setq itm (car lst))
       (setq lst (vl-remove itm lst) result (cons itm result)))))
     
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)) i 2)
 
 (cond (  (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
          (princ "\n<< Current Layer Locked >>"))
       
       (t (if (and (setq k -1 ss  (ssget '((0 . "TEXT,MTEXT"))))
                   (setq bPt (getpoint "\nSelect Point for Table: ")))
            (progn
              (setq uFlag (not (vla-StartUndoMark doc)))

              (while (setq ent (ssname ss (setq k (1+ k))))
                (setq lst (cons (cdr (assoc 1 (entget ent))) lst)))
              
              (foreach Str (unique lst)
                (setq cnt 0)
                
                (if (setq j -1 tss (ssget "_X" (list '(-4 . "<OR")
                                                       '(-4 . "<AND")
                                                         '(0 . "TEXT,MTEXT")
                                                          (cons 1 str)
                                                       '(-4 . "AND>")
                                                       '(-4 . "<AND")
                                                         '(0 . "INSERT")
                                                         '(66 . 1)
                                                       '(-4 . "AND>")
                                                     '(-4 . "OR>"))))
                  
                  (while (setq ent (ssname tss (setq j (1+ j))))
                    (setq Obj (vlax-ename->vla-object ent))

                    (cond (  (eq "AcDbBlockReference" (vla-get-ObjectName Obj))

                             (foreach Att (append
                                            (vlax-safearray->list
                                              (vlax-variant-value
                                                (vla-getAttributes Obj)))
                                            (if
                                              (not
                                                (vl-catch-all-error-p
                                                  (setq cAtt
                                                    (vl-catch-all-apply 'vlax-safearray->list
                                                      (list
                                                        (vlax-variant-value
                                                          (vla-getConstantAttributes Obj))))))) cAtt))

                               (if (eq Str (vla-get-TextString Att)) (setq cnt (1+ cnt)))))

                          (t (setq cnt (1+ cnt))))))
                
               (setq oLst (cons (cons str cnt) oLst)))
              
             (setq tblObj
               (vla-addTable spc
                 (vlax-3D-point bPt) (+ 2 (length olst)) 2 (* 1.5 (getvar "DIMTXT"))
                   (* (apply 'max
                        (mapcar 'strlen
                          (append '("String")
                            (apply 'append
                              (mapcar (function (lambda (x) (list (car x) (itoa (cdr x))))) olst)))))

                      2.0 (getvar "DIMTXT"))))
              
             (vla-setText tblObj 0 0 "String Counter")
               (vla-setText tblObj 1 0 "String")              
                 (vla-setText tblObj 1 1 "Count")
              
             (foreach x (vl-sort olst (function (lambda (a b) (< (car a) (car b)))))
               (vla-setText tblObj i 0 (car x))
                 (vla-setText tblObj i 1 (itoa (cdr x)))
                   (setq i (1+ i)))
              
             (setq uflag (vla-EndUndoMark doc))))))
              
 (princ))
             

 

 

EDIT: A quick test on the single Dynamic Block I have... shows it seems to work.

Posted

Hi,

That is amazing, thank you.

Is there a way of making the table return only number greater that 1?

Thanks

Posted
Hi,

That is amazing, thank you.

Is there a way of making the table return only number greater that 1?

Thanks

 

Yes, just to clarify, do you mean greater than 1, or greater than or equal to 1?

 

Lee

Posted

Greater that 1.

 

Because the lisp will search through dynamic blocks but not let me select the text from them to search for, I have put a text entity of every possible number /letter I want it to search for. That way there is 1 of everything in model space + the actual number.

So really I guess the best thing would be if the routine returned every minus 1. This would remove the things equal to 1 and give the correct value I require.

Am I making any sense?

I really appreciate the help, thanks

Posted

Would it be easier if I allowed the user to select Blocks to add to the text strings to search?

 

Or maybe, what if the code just produced a report on every text string in the drawing?

Posted

Erhm, yes, either of those would work I think. maybe selecting block would be worth a try. will that work for dynamic blocks?

Posted
Erhm, yes, either of those would work I think. maybe selecting block would be worth a try. will that work for dynamic blocks?

 

If the above code works for Dynamic Blocks, then yes, hopefully :)

Posted

Try this:

 

(defun c:tsel (/ *error* unique BPT CATT CNT DOC ENT I ITM J
                    K LST OBJ OLST SPC SS TBLOBJ TSS UFLAG)
 
 ;; by Lee McDonnell (Lee Mac)
 
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (defun unique (lst / result)
   (reverse
     (while (setq itm (car lst))
       (setq lst (vl-remove itm lst) result (cons itm result)))))
     
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)) i 2)
 
 (cond (  (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
          (princ "\n<< Current Layer Locked >>"))
       
       (t (if (and (setq k -1 ss  (ssget '((-4 . "<OR")
                                             (0 . "TEXT,MTEXT")
                                             (-4 . "<AND")
                                               (0 . "INSERT")
                                               (66 . 1)
                                             (-4 . "AND>")
                                           (-4 . "OR>"))))
                   
                   (setq bPt (getpoint "\nSelect Point for Table: ")))
            (progn
              (setq uFlag (not (vla-StartUndoMark doc)))

              (while (setq ent (ssname ss (setq k (1+ k))))
                (setq obj (vlax-ename->vla-object ent))

                (setq lst

                  (append lst

                    (cond (  (eq "AcDbBlockReference" (vla-get-ObjectName Obj))

                             (mapcar (function vla-get-TextString)
                                     (append
                                       (vlax-safearray->list
                                         (vlax-variant-value
                                           (vla-getAttributes Obj)))
                                             (if
                                               (not
                                                 (vl-catch-all-error-p
                                                   (setq cAtt
                                                     (vl-catch-all-apply 'vlax-safearray->list
                                                       (list
                                                         (vlax-variant-value
                                                           (vla-getConstantAttributes Obj))))))) cAtt))))

                          (t (list (vla-get-TextString obj)))))))

              (foreach Str (unique lst)
                (setq cnt 0)
                
                (if (setq j -1 tss (ssget "_X" (list '(-4 . "<OR")
                                                       '(-4 . "<AND")
                                                         '(0 . "TEXT,MTEXT")
                                                          (cons 1 str)
                                                       '(-4 . "AND>")
                                                       '(-4 . "<AND")
                                                         '(0 . "INSERT")
                                                         '(66 . 1)
                                                       '(-4 . "AND>")
                                                     '(-4 . "OR>"))))
                  
                  (while (setq ent (ssname tss (setq j (1+ j))))
                    (setq Obj (vlax-ename->vla-object ent))

                    (cond (  (eq "AcDbBlockReference" (vla-get-ObjectName Obj))

                             (foreach Att (append
                                            (vlax-safearray->list
                                              (vlax-variant-value
                                                (vla-getAttributes Obj)))
                                            (if
                                              (not
                                                (vl-catch-all-error-p
                                                  (setq cAtt
                                                    (vl-catch-all-apply 'vlax-safearray->list
                                                      (list
                                                        (vlax-variant-value
                                                          (vla-getConstantAttributes Obj))))))) cAtt))

                               (if (eq Str (vla-get-TextString Att)) (setq cnt (1+ cnt)))))

                          (t (setq cnt (1+ cnt))))))
                
               (setq oLst (cons (cons str cnt) oLst)))
              
             (setq tblObj
               (vla-addTable spc
                 (vlax-3D-point bPt) (+ 2 (length olst)) 2 (* 1.5 (getvar "DIMTXT"))
                   (* (apply 'max
                        (mapcar 'strlen
                          (append '("String")
                            (apply 'append
                              (mapcar (function (lambda (x) (list (car x) (itoa (cdr x))))) olst)))))

                      2.0 (getvar "DIMTXT"))))
              
             (vla-setText tblObj 0 0 "String Counter")
               (vla-setText tblObj 1 0 "String")              
                 (vla-setText tblObj 1 1 "Count")
              
             (foreach x (vl-sort olst (function (lambda (a b) (< (car a) (car b)))))
               (vla-setText tblObj i 0 (car x))
                 (vla-setText tblObj i 1 (itoa (cdr x)))
                   (setq i (1+ i)))
              
             (setq uflag (vla-EndUndoMark doc))))))
              
 (princ))

Posted

Thank you

That is just the job. that will save me so much counting

Cheers

Merry chrimbo

J

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