CXTXTCOUNTTextVersion 1.0.0Tested in AutoCAD

Count identical texts

Lists every different text in the drawing or selection with how often it occurs, most frequent first. Useful for room names, tags and notes.

Download cxtxtcount.lsp LISP terms

How to use it

Type CXTXTCOUNT and choose All or Selection.
Choose whether upper and lower case count as different.
Read the list at the command line, or place it in the drawing as a text block.

Good to know

Counts are taken in the current model or layout tab.

Load it in AutoCAD

Save the file anywhere you like.
Type APPLOAD, pick the file and choose Load.
Type the command name: CXTXTCOUNT.

To have it at every start, add it to the Startup Suite in the same dialog, or load a whole folder at once with the optional loader. About the optional loader

Tested in AutoCAD (full version). Other programs that run AutoLISP may work, but they are not tested.

The code

Plain text, nothing hidden. Copy it into a file named cxtxtcount.lsp, or download it.

;;; ============================================================================
;;; CXTXTCOUNT - Count how often each text occurs
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxtxtcount
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; Count how often each text occurs among the objects in NAMES. MATCHCASE = T tells "A" and "a" apart.
;; Returns ((text . count) ...), the most frequent first, equal counts in alphabetical order.
(defun cx:txtcount-run (names matchcase / table key s pair)
  (foreach e names
    (setq s   (cx:trim (cx:text-plain (cx:text-get e) (= (cx:dxf 0 (entget e)) "MTEXT") nil))
          s   (cx:replace s "\n" " ")
          key (if matchcase s (strcase s)))
    (if (/= s "")
      (if (setq pair (assoc key table))
        (setq table (subst (cons key (cons (cadr pair) (1+ (cddr pair)))) pair table))
        (setq table (cons (cons key (cons s 1)) table)))))
  ;; table items are (key shown . count)
  (cx:sort
    (mapcar (function (lambda (p) (cons (cadr p) (cddr p)))) table)
    (function (lambda (a b) (or (> (cdr a) (cdr b)) (and (= (cdr a) (cdr b)) (< (strcase (car a)) (strcase (car b)))))))))

(defun c:CXTXTCOUNT ( / *error* cx:sv ss rows pt lines)
  (setq *error* cx:err)
  (setq ss (if (= (cx:ask-kw "Count texts in" "All Selection" "All") "All")
             (ssget "X" '((0 . "TEXT,MTEXT")))
             (cx:pick "\nSelect texts: " '((0 . "TEXT,MTEXT")))))
  (if ss
    (progn
      (setq rows (cx:txtcount-run (cx:ss->list ss) (= (cx:ask-kw "Match case" "Yes No" "No") "Yes")))
      (princ (strcat "\n" (itoa (length rows)) " different text(s):"))
      (foreach r rows (princ (strcat "\n" (itoa (cdr r)) " x  " (car r))))
      (if (and rows (= (cx:ask-kw "Place the list in the drawing" "Yes No" "No") "Yes")
               (setq pt (getpoint "\nTop-left corner of the list: ")))
        (progn
          (cx:start '(("CMDECHO" . 0)))
          (setq lines (mapcar (function (lambda (r) (strcat (car r) " : " (itoa (cdr r))))) rows))
          (entmakex (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 pt)
                          (cons 40 (getvar "TEXTSIZE")) '(41 . 0.0) '(71 . 1) '(72 . 5)
                          (cons 1 (cx:join lines "\\P")) (cons 7 (getvar "TEXTSTYLE"))))
          (cx:end)))
      (princ))
    (princ "\nNo texts found."))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Remove spaces and tabs at both ends.
(defun cx:trim (s / a b)
  (setq a 1 b (strlen s))
  (while (and (<= a b) (member (substr s a 1) '(" " "\t"))) (setq a (1+ a)))
  (while (and (>= b a) (member (substr s b 1) '(" " "\t"))) (setq b (1- b)))
  (substr s a (max 0 (1+ (- b a)))))

;; Split a TEXT (MT = nil) or MTEXT (MT = T) string into ((T . "plain") (C . "format code") ...).
;; Codes are %%c-style symbols, and in MTEXT also \P, \f...; \H...; \S...; {, } and the like.
(defun cx:fmt-tokens (str mt / out plain i n c d j k)
  (setq out nil plain "" i 1 n (strlen str))
  (while (<= i n)
    (setq c (substr str i 1) k 0)
    (cond
      ((and (= c "%") (= (substr str (1+ i) 1) "%") (< (1+ i) n))
       (setq k (if (wcmatch (substr str (+ i 2) 1) "#") 5 3)))
      ((and mt (= c "\\"))
       (setq d (substr str (1+ i) 1))
       (cond
         ((= d "") (setq k 1))
         ((member d '("P" "X" "x" "L" "l" "O" "o" "K" "k" "~" "\\" "{" "}")) (setq k 2))
         ((member d '("U" "u")) (setq k 7))
         (T
          (setq j i)
          (while (and (<= j n) (/= (substr str j 1) ";")) (setq j (1+ j)))
          (setq k (if (<= j n) (1+ (- j i)) 2)))))
      ((and mt (or (= c "{") (= c "}"))) (setq k 1)))
    (if (> k 0)
      (progn
        (if (/= plain "") (setq out (cons (cons 'T plain) out) plain ""))
        (setq out (cons (cons 'C (substr str i k)) out) i (+ i k)))
      (setq plain (strcat plain c) i (1+ i))))
  (if (/= plain "") (setq out (cons (cons 'T plain) out)))
  (reverse out))

;; The visible text of a TEXT or MTEXT string. In MTEXT, \P becomes a line break (KEEPNL = T: the two characters \P are kept).
(defun cx:text-plain (str mt keepnl / out)
  (setq out "")
  (foreach tk (cx:fmt-tokens str mt)
    (cond
      ((= (car tk) 'T) (setq out (strcat out (cdr tk))))
      ((= (cdr tk) "\\P") (setq out (strcat out (if keepnl "\\P" "\n"))))
      ((= (cdr tk) "\\~") (setq out (strcat out " ")))
      ((member (cdr tk) '("\\\\" "\\{" "\\}")) (setq out (strcat out (substr (cdr tk) 2))))))
  out)

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; The text of a TEXT, ATTRIB, ATTDEF or MTEXT (MTEXT keeps its codes).
(defun cx:text-get (ename / ed s)
  (setq ed (entget ename))
  (if (= (cx:dxf 0 ed) "MTEXT")
    (progn
      (setq s "")
      (foreach p ed (if (= (car p) 3) (setq s (strcat s (cdr p)))))
      (strcat s (cx:dxf 1 ed)))
    (cx:dxf 1 ed)))

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; Merge sort of LST with PRED (a function of two items that is true when the first goes first).
(defun cx:sort (lst pred / half a b out)
  (cond
    ((or (null lst) (null (cdr lst))) lst)
    (T
     (setq half (/ (length lst) 2) a nil b lst)
     (repeat half (setq a (cons (car b) a) b (cdr b)))
     (setq a (cx:sort (reverse a) pred) b (cx:sort b pred) out nil)
     (while (and a b)
       (if (apply pred (list (car b) (car a)))
         (setq out (cons (car b) out) b (cdr b))
         (setq out (cons (car a) out) a (cdr a))))
     (append (reverse out) a b))))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

;; Save the system variables in VARS ((name . value) ...), set them, and open one undo step.
;; The caller declares cx:sv as a local so the saved values live exactly as long as the command.
(defun cx:start (vars)
  (setq cx:sv (mapcar (function (lambda (v) (cons (car v) (getvar (car v))))) vars))
  (command "_.UNDO" "_Begin")
  (foreach v vars (setvar (car v) (cdr v)))
  (princ))

(defun cx:join (lst delim / out)
  (setq out "")
  (foreach s lst
    (setq out (if (= out "") s (strcat out delim s))))
  (if lst out ""))

(princ "\nCXTXTCOUNT loaded. Type CXTXTCOUNT to start.")
(princ)

Version history

Version 1.0.0 · October 27, 2026

First release.