CXFONTSUB清理版本 1.0.0已在 AutoCAD 中测试
在所有文字样式里把一个字体文件换成另一个
把所有使用某个字体文件的文字样式改用另一个字体文件，并重生成图形让你看到效果。
怎么用
- 输入 CXFONTSUB。
- 输入要被替换的字体文件，例如 romans.shx。
- 输入改用的字体文件，例如 simplex.shx。
需要知道
- 被修改的样式里的大字体设置会被清空。
在 AutoCAD 中加载
- 把文件保存在任意位置。
- 输入 APPLOAD，选择文件，点“加载”。
- 输入命令名：CXFONTSUB。
想每次启动都可用，在同一个对话框里加入“启动组”，或用可选的加载器一次加载整个文件夹。 关于可选的加载器
已在 AutoCAD（完整版）中测试。其他能运行 AutoLISP 的软件也许可用，但未经测试。
代码
纯文本，没有任何隐藏内容。复制后存成名为 cxfontsub.lsp 的文件，或直接下载。
;;; ============================================================================
;;; CXFONTSUB - Replace one font file by another in all text styles
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxfontsub
;;; 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
;;; ============================================================================
;; Give every text style that uses the font file FROM (case ignored) the font file TO instead.
;; A big font file of such a style is cleared. Returns the style names changed.
(defun cx:fontsub-run (from to / r out names en ed)
(setq r (tblnext "STYLE" T))
(while r
(if (and (cx:dxf 3 r) (= (strcase (cx:dxf 3 r)) (strcase from)))
(setq names (cons (cx:dxf 2 r) names)))
(setq r (tblnext "STYLE")))
(foreach name (reverse names)
(setq ed (entget (tblobjname "STYLE" name)))
(setq ed (subst (cons 3 to) (assoc 3 ed) ed))
(if (assoc 4 ed) (setq ed (subst (cons 4 "") (assoc 4 ed) ed)))
(entmod ed)
(setq out (cons name out)))
(reverse out))
(defun c:CXFONTSUB ( / *error* cx:sv from to rows)
(setq *error* cx:err)
(setq from (cx:ask-str "Font file to replace (for example romans.shx)" ""))
(if (= from "")
(princ "\nNothing to replace.")
(progn
(setq to (cx:ask-str "Replace it with (for example simplex.shx)" ""))
(if (= to "")
(princ "\nNo replacement given.")
(progn
(cx:start '(("CMDECHO" . 0)))
(setq rows (cx:fontsub-run from to))
(foreach r rows (princ (strcat "\n" r)))
(command "_.REGENALL")
(princ (strcat "\n" (itoa (length rows)) " text style(s) changed."))
(cx:end)))))
(princ))
;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----
(defun cx:dxf (code ed)
(cdr (assoc code 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))
;; 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 "\nCXFONTSUB loaded. Type CXFONTSUB to start.")
(princ)
版本记录
版本 1.0.0 · 2026年10月27日
首个版本。
要对很多张图一起做？
TextSync 可以对整个文件夹的图纸一次完成这类工作。
TextSync