CXTXTSUM文字バージョン 1.0.0AutoCAD で動作確認済み
文字の中の数値を合計する
選択した文字に含まれる数値（数量や長さなど）を読み取り、合計、平均、最小値、最大値を報告します。
使い方
- CXTXTSUM と入力し、文字を選択します。
- 各文字の最初の数値だけを使うか、すべての数値を使うかを選びます。
- 合計をラベル（例: 合計）付きで図面に配置することもできます。
知っておくこと
- 1,234.5 のような桁区切りも認識します。
AutoCAD で読み込む
- ファイルを好きな場所に保存します。
- APPLOAD と入力し、ファイルを選んで「ロード」を押します。
- コマンド名を入力します：CXTXTSUM。
起動のたびに使うには、同じ画面で「スタートアップ スイート」に追加するか、任意のローダーでフォルダーごと読み込みます。 任意のローダーについて
AutoCAD（フル版）で動作確認しています。AutoLISP を実行できるほかのソフトでも動く場合がありますが、確認はしていません。
コード
隠している部分のないテキストです。cxtxtsum.lsp という名前のファイルにコピーするか、ダウンロードしてください。
;;; ============================================================================
;;; 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)
バージョン履歴
バージョン 1.0.0 · 2026年10月27日
最初のリリース。