すべての文字スタイルでフォントファイルを置き換える

隠している部分のないテキストです。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図形を種類別に数える