모든 문자 스타일의 글꼴 파일 교체

숨겨진 부분이 없는 일반 텍스트입니다. 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길이가 0인 선과 폴리선 찾아 삭제
• CXEMPTYTXT빈 문자 찾아 삭제
• CXFONTCHK글꼴 파일이 없는 문자 스타일 목록
• CXPURGE더 지울 것이 없을 때까지 도면 정리
• CXDELTYPE선택한 종류의 객체 모두 삭제
• CXDIMRESET직접 고친 치수 문자를 측정값으로 되돌리기
• CXDUPDEL완전히 중복된 객체 삭제
• CXOBJCOUNT객체를 종류별로 세기