stockers Posted December 22, 2009 Posted December 22, 2009 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 Quote
ReMark Posted December 22, 2009 Posted December 22, 2009 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? Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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 Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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 Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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)) Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 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. Quote
ReMark Posted December 22, 2009 Posted December 22, 2009 Why didn't you mention that little detail (dynamic block) in the first place? It really helps to have all the information up front. Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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... Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 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. Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 Eeeek! Not really... only because I have limited experience with Dyn Blocks... 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. Quote
ReMark Posted December 22, 2009 Posted December 22, 2009 Please consider changing your profile to reflect the software you actually use. Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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. Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 Hi, That is amazing, thank you. Is there a way of making the table return only number greater that 1? Thanks Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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 Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 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 Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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? Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 Erhm, yes, either of those would work I think. maybe selecting block would be worth a try. will that work for dynamic blocks? Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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 Quote
Lee Mac Posted December 22, 2009 Posted December 22, 2009 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)) Quote
stockers Posted December 22, 2009 Author Posted December 22, 2009 Thank you That is just the job. that will save me so much counting Cheers Merry chrimbo J Quote
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.