Lisp to deal with text/Mtext

[asos2000]

Is there a lisp do this job
To select the text (and Mtext too) and but each string in a single line and but next to it the count of that string

For example

I have this text in a drawing
T12-100
T10-100
T16-100
T12-150

And the same values repeated (in the same file)
The lisp collects the text string and count how many time repeated each text/Mtext

Text Repetition
T12-100 5
T10-100 6
T16-100 16
T12-150 7

And so on

Hasan

[Lee Mac]

Try this:

(defun c:tsel (/ ss lst tss olst ofile)
  (vl-load-com)
  (if (setq ss (ssget '((0 . "*TEXT"))))
    (progn
      (setq lst
        (mapcar
          (function
            (lambda (x)
              (vla-get-TextString
                (vlax-ename->vla-object x))))
          (vl-remove-if 'listp
            (mapcar 'cadr (ssnamex ss)))))
      (foreach str (unique lst)
        (if (setq tss
              (ssget "_X"
                (list '(0 . "*TEXT") (cons 1 str))))
          (setq olst
            (cons
              (cons str (sslength tss)) olst))
          (setq olst
            (cons
              (cons str 0.) olst))))
      (setq ofile
        (open
          (strcat
            (getvar "DWGPREFIX")
              (substr
                (getvar "DWGNAME") 1
                  (- (strlen
                       (getvar "DWGNAME")) 4)) "-StrCnt.txt") "a"))
      (mapcar
        (function
          (lambda (x)
            (write-line
              (strcat (car x) "\t"
                (vl-princ-to-string (cdr x))) ofile))) olst)
      (close ofile)
      (princ "\n<< Strings Written to File >>"))
    (princ "\n<< Nothing Selected >>"))
  (princ))

;; CAB
(defun unique (lst / result)
  (reverse
    (while (setq itm (car lst))
      (setq lst (vl-remove itm lst)
            result (cons itm result)))))

Will write the result to file.

[asos2000]

whats great

Could be the result in a table in the same file


Regards

[Lee Mac]

whats great

Could be the result in a table in the same file


Regards

Wasn't sure if '06 had tables, but yes, this could be done;

[Lee Mac]

Ok try this:

(defun c:tsel (/ *error* doc spc ss bPt
                 lst tss olst tblObj i)
  (vl-load-com)

  (defun *error* (msg)
    (and doc (vla-EndUndoMark doc))
    (if
      (not
        (wcmatch
          (strcase msg)
            "*BREAK,*CANCEL*,*EXIT*"))
      (princ
        (strcat
          "\n<< Error: " msg " >>")))
    (princ))
      
  (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 ss (ssget '((0 . "*TEXT"))))
                   (setq bPt (getpoint "\nSelect Point for Table: ")))
            (progn
              (vla-StartUndoMark doc)
              (setq lst
                (mapcar
                  (function
                    (lambda (x)
                      (vla-get-TextString
                        (vlax-ename->vla-object x))))
                  (vl-remove-if 'listp
                    (mapcar 'cadr (ssnamex ss)))))
              (foreach str (unique lst)
                (if (setq tss
                      (ssget "_X"
                        (list '(0 . "*TEXT") (cons 1 str))))
                  (setq olst
                    (cons
                      (cons str (sslength tss)) olst))
                  (setq olst
                    (cons
                      (cons str 0.) 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)
                                         (rtos (cdr x) 2 0)))) olst)))))
                         1.5 (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 (rtos (cdr x) 2 0))
                    (setq i (1+ i)))
              (vla-EndUndoMark doc)))))
  (princ))
              

;; CAB
(defun unique (lst / result)
  (reverse
    (while (setq itm (car lst))
      (setq lst (vl-remove itm lst)
            result (cons itm result)))))

[asos2000]

WOW, that what im looking for.
Thanks LEE

But there are 2 points
- Could the lisp use the default text style (not standard)?
- STRING & COUNT words in the table come in 2 lines when the text string is one or tow digits.

mmmm, while typing there are 2 more things came in my mind
- Could I choose the table style (there are stored table styles in the file)?
- Could the lisp collect the text/attribute in the blocks?

[Lee Mac]

But there are 2 points
- Could the lisp use the default text style (not standard)?
- STRING & COUNT words in the table come in 2 lines when the text string is one or tow digits.

mmmm, while typing there are 2 more things came in my mind
- Could I choose the table style (there are stored table styles in the file)?
- Could the lisp collect the text/attribute in the blocks?

The LISP uses the default TableStyle - so just set the table style how you want it.

As for the STRING and COUNT coming in as 2 lines, I thought I had accounted for this, but I can increase the column width if necessary.

As for the blocks - will you still be selecting them?

[asos2000]

As for the blocks, No need for still be selecting them.

I creat that macro but not working

-table;;;style;EC-TABLE-100;;stringcounter;

EC-TABLE-100 is a tablestyle

[Lee Mac]

- Could the lisp collect the text/attribute in the blocks?

I can maybe collect attributes, but text is annoying to get out of blocks - are you just wanting the LISP to scour every block in the drawing?

[asos2000]

Not every block but selected blocks