CADXChange

All LISP commands

CXTXTSUMTextVersion 1.0.0Tested in AutoCAD

Add up the numbers in texts

Reads the numbers in selected texts, such as quantities or lengths, and reports their sum, average, smallest and largest value.

How to use it

  1. Type CXTXTSUM and select the texts.
  2. Choose whether to add the first number in each text or every number.
  3. Optionally place the sum in the drawing with a label such as Total.

Good to know

  • Thousands separators like 1,234.5 are understood.

Load it in AutoCAD

  1. Save the file anywhere you like.
  2. Type APPLOAD, pick the file and choose Load.
  3. Type the command name: CXTXTSUM.

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 cxtxtsum.lsp, or download it.

;;; ============================================================================
;;; CXTXTSUM - Add up the numbers in texts
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxtxtsum
;;; 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
;;; ============================================================================

;; Add up the numbers in the texts of NAMES. MODE "First" takes the first number of each text, "All" every number in it.
;; Returns (sum count min max), or nil when no number was found.
(defun cx:txtsum-run (names mode / vals nums)
  (foreach e names
    (setq nums (cx:numbers (cx:text-plain (cx:text-get e) (= (cx:dxf 0 (entget e)) "MTEXT") nil)))
    (if nums
      (setq vals (append vals (if (= mode "First") (list (car nums)) nums)))))
  (if vals
    (list (apply '+ vals) (length vals) (apply 'min vals) (apply 'max vals))))

(defun c:CXTXTSUM ( / *error* cx:sv ss mode r prec pt label)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect texts that hold numbers: " '((0 . "TEXT,MTEXT"))))
    (progn
      (setq mode (cx:ask-kw "Numbers to add up" "First All" "First")
            prec (getvar "LUPREC"))
      (if (setq r (cx:txtsum-run (cx:ss->list ss) mode))
        (progn
          (princ (strcat "\nNumbers: " (itoa (cadr r))
                         "   Sum: " (cx:num (car r) prec)
                         "   Average: " (cx:num (/ (car r) (cadr r)) prec)
                         "   Min: " (cx:num (caddr r) prec)
                         "   Max: " (cx:num (cadddr r) prec)))
          (if (and (= (cx:ask-kw "Place the sum in the drawing" "Yes No" "No") "Yes")
                   (setq pt (getpoint "\nInsertion point: ")))
            (progn
              (setq label (cx:ask-str "Label (- for none)" "Total: "))
              (cx:start '(("CMDECHO" . 0)))
              (entmakex (list '(0 . "TEXT") (cons 10 pt) (cons 40 (getvar "TEXTSIZE"))
                              (cons 1 (strcat label (cx:num (car r) prec))) (cons 7 (getvar "TEXTSTYLE"))))
              (cx:end))))
        (princ "\nNo numbers found in the selected texts."))))
  (princ))


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

;; All numbers in a string as a list of reals ("A12 x 3.5, -2" -> (12.0 3.5 -2.0)).
;; A thousands comma ("1,234.5") is understood; a minus counts as a sign only when it does not follow a letter or digit.
(defun cx:numbers (s / out i n c cur dot neg prev)
  (setq out nil cur "" i 1 n (strlen s) dot nil neg nil)
  (while (<= i (1+ n))
    (setq c (if (<= i n) (substr s i 1) ""))
    (cond
      ((wcmatch c "#") (setq cur (strcat cur c)))
      ((and (= c ".") (not dot) (wcmatch (substr s (1+ i) 1) "#"))
       (setq cur (strcat (if (= cur "") "0" cur) ".") dot T))
      ((and (= c ",") (/= cur "") (not dot) (wcmatch (substr s (1+ i) 3) "###") (not (wcmatch (substr s (+ i 4) 1) "#")))
       nil)
      (T
       (if (/= cur "")
         (setq out (cons (* (if neg -1.0 1.0) (atof cur)) out)))
       (setq prev (if (> i 1) (substr s (1- i) 1) ""))
       (setq neg (and (= c "-")
                      (not (wcmatch prev "[A-Za-z0-9]"))
                      (or (wcmatch (substr s (1+ i) 1) "#") (and (= (substr s (1+ i) 1) ".") (wcmatch (substr s (+ i 2) 1) "#")))))
       (setq cur "" dot nil)))
    (setq i (1+ i)))
  (reverse out))

;; 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)))

;; 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))

;; 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)

;; 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)))))

;; 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))

;; 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))

;; Real X as text with at most PREC decimals and no trailing zeros ("2.50" -> "2.5", "3.00" -> "3").
(defun cx:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (wcmatch s "*.*")
    (progn
      (while (= (substr s (strlen s)) "0") (setq s (substr s 1 (1- (strlen s)))))
      (if (= (substr s (strlen s)) ".") (setq s (substr s 1 (1- (strlen s)))))))
  (if (or (= s "-0") (= s "")) "0" s))

;; Ask for a string (spaces allowed) with a default; "-" means an empty string.
(defun cx:ask-str (msg def / v)
  (setq v (getstring T (strcat "\n" msg " <" def ">: ")))
  (cond ((= v "") def) ((= v "-") "") (T v)))

;; 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))

(princ "\nCXTXTSUM loaded. Type CXTXTSUM to start.")
(princ)

Version history

Version 1.0.0 · October 27, 2026

First release.

More commands: Text