CXFONTSUBAufräumenVersion 1.0.0In AutoCAD getestet

In allen Textstilen eine Schriftdatei durch eine andere ersetzen

Stellt jeden Textstil, der eine bestimmte Schriftdatei nutzt, auf eine andere um und regeneriert die Zeichnung, damit Sie das Ergebnis sehen.

cxfontsub.lsp herunterladen LISP-Bedingungen

So verwenden Sie ihn

CXFONTSUB eingeben.
Die zu ersetzende Schriftdatei eingeben, zum Beispiel romans.shx.
Die Schriftdatei eingeben, die stattdessen gelten soll, zum Beispiel simplex.shx.

Gut zu wissen

Die Bigfont-Angaben der geänderten Stile werden gelöscht.

In AutoCAD laden

Speichern Sie die Datei an einem beliebigen Ort.
Geben Sie APPLOAD ein, wählen Sie die Datei und klicken Sie auf Laden.
Geben Sie den Befehl ein: CXFONTSUB.

Damit er bei jedem Start bereitsteht, fügen Sie ihn im selben Dialog zum Startup-Set hinzu, oder laden Sie mit dem optionalen Loader einen ganzen Ordner auf einmal. Der optionale Loader

In AutoCAD (Vollversion) getestet. Andere Programme, die AutoLISP ausführen, funktionieren vielleicht, wurden aber nicht getestet.

Der Code

Reiner Text, nichts ist versteckt. Kopieren Sie ihn in eine Datei namens cxfontsub.lsp oder laden Sie ihn herunter.

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

Versionsverlauf

Version 1.0.0 · 27. Oktober 2026

Erste Veröffentlichung.

Für viele Zeichnungen auf einmal?

TextSync erledigt diese Art von Aufgabe für einen ganzen Ordner voller Zeichnungen in einem Durchlauf.

TextSync