在所有文字樣式裡把一個字型檔案換成另一個

純文字，沒有任何隱藏內容。複製後存成名為 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)

更多指令：清理

• CXBYLAYER把顏色、線型和線寬恢復為 ByLayer
• CXZEROLEN找出並刪除零長度的直線和多段線
• CXEMPTYTXT找出並刪除空文字
• CXFONTCHK列出字型檔案缺失的文字樣式
• CXPURGE反覆清理圖形，直到沒有可清的內容
• CXDELTYPE刪除你點選型別的所有物件
• CXDIMRESET把手改過的標註文字恢復成測量值
• CXDUPDEL刪除完全重複的物件
• CXOBJCOUNT按型別統計物件數量