AutoCADマクロ屋本舗 掲示板

お世話になります
別CADからDWGに変換したデータがあるのですが、寸法の優先値に
例：\A1;\W1.0006;\Q0.0000;\T0.9957;10@200=2000のような表記があります
見た目は10@200=2000なのですがこれをマクロやLISPで見た目表記のみにできますでしょうか

W1.0006が文字幅係数なのですが文字が太く見えてしまうのでWを1にするだけでも構わないです
実寸法ではないので優先値は残したままにしたいです

よろしくお願いいたします

;;; ============================================================
;;; AutoCAD MText / Dimension / Text / MLeader
;;; 書式コード除去 ＆ オブジェクトへ書き戻し
;;;
;;; コマンド：
;;; PLAIN
;;;
;;; 対象：
;;; MText
;;; Dimension
;;; TEXT
;;; MLeader
;;;
;;; 以下の書式を削除
;;;
;;; \A1;
;;; \W...;
;;; \H...;
;;; \Q...;
;;; \T...;
;;; \F...;
;;; \C...;
;;; \S...; 分数
;;; \P 改行
;;; \L...\l 下線
;;; \O...\o 上線
;;; {...} グループ
;;; \~
;;;
;;; 以下を変換
;;; %%d → °
;;; %%c → ⌀
;;; %%p → ±
;;; %%u / %%o
;;;
;;; ============================================================


;;; ------------------------------------------------------------
;;; AutoCAD書式コードを除去してプレーンテキストにする
;;; ------------------------------------------------------------

(defun RemoveMTextFormat
(str
/ i len ch next result temp code
slashPos semiPos braceDepth)

(setq i 1
len (strlen str)
result ""
braceDepth 0)

(while (<= i len)

(setq ch (substr str i 1))

(cond

;; ========================================================
;; { } グループ指定
;; ========================================================

((= ch "{")
(setq braceDepth (1+ braceDepth))
(setq i (1+ i))
)

((= ch "}")
(setq braceDepth (max 0 (1- braceDepth)))
(setq i (1+ i))
)


;; ========================================================
;; バックスラッシュによるMText書式
;; ========================================================

((= ch "\\")

(if (< i len)

(progn

(setq next (substr str (1+ i) 1))

(cond

;; -------------------------------------------------
;; \P → 改行
;; -------------------------------------------------

((= (strcase next) "P")

(setq result
(strcat result "\n")
)

(setq i (+ i 2))
)


;; -------------------------------------------------
;; \~ → ノーブレークスペース
;; -------------------------------------------------

((= next "~")

(setq result
(strcat result " ")
)

(setq i (+ i 2))
)


;; -------------------------------------------------
;; \L → 下線開始
;; \l → 下線終了
;; -------------------------------------------------

((or (= next "L")
(= next "l"))

(setq i (+ i 2))
)


;; -------------------------------------------------
;; \O → 上線開始
;; \o → 上線終了
;; -------------------------------------------------

((or (= next "O")
(= next "o"))

(setq i (+ i 2))
)


;; -------------------------------------------------
;; \S → 分数
;;
;; \S1/2;
;; \S1#2;
;; \S1^2;
;;
;; → 1/2
;; -------------------------------------------------

((= (strcase next) "S")

(setq i (+ i 2))
(setq temp "")

(while
(and
(<= i len)
(/= (substr str i 1) ";")
)

(setq temp
(strcat
temp
(substr str i 1)
)
)

(setq i (1+ i))
)

;; # を /
(setq temp
(vl-string-subst "/" "#" temp)
)

;; ^ を /
(setq temp
(vl-string-subst "/" "^" temp)
)

;; 既に / の場合はそのまま

(setq result
(strcat result temp)
)

;; ; を飛ばす
(if (<= i len)
(setq i (1+ i))
)
)


;; -------------------------------------------------
;; \A1;
;; \A0;
;; \A2;
;; → 削除
;; -------------------------------------------------

((= (strcase next) "A")

(setq i (+ i 2))

(while
(and
(<= i len)
(/= (substr str i 1) ";")
)

(setq i (1+ i))
)

(if (<= i len)
(setq i (1+ i))
)
)


;; -------------------------------------------------
;; \W...;
;; \H...;
;; \Q...;
;; \T...;
;; \F...;
;; \C...;
;; \K...;
;; \p...;
;;
;; 書式指定 → 削除
;; -------------------------------------------------

((member
(strcase next)
'("W" "H" "Q" "T" "F" "C" "K" "P")
)

(setq i (+ i 2))

(while
(and
(<= i len)
(/= (substr str i 1) ";")
)

(setq i (1+ i))
)

(if (<= i len)
(setq i (1+ i))
)
)


;; -------------------------------------------------
;; その他の \X
;;
;; 未知の書式コードも
;; \X の部分だけ削除
;; -------------------------------------------------

(T

(setq i (+ i 2))
)
)
)

;; "\" が文字列末尾の場合
(setq i (1+ i))
)
)


;; ========================================================
;; %% 系の特殊コード
;; ========================================================

((and
(= ch "%")
(< i len)
(= (substr str (1+ i) 1) "%")
)

(if (<= (+ i 2) len)

(progn

(setq code
(strcase
(substr str (+ i 2) 1)
)
)

(cond

;; %%d → 度
((= code "D")
(setq result
(strcat result "°")
)
)

;; %%p → ±
((= code "P")
(setq result
(strcat result "±")
)
)

;; %%c → ⌀
((= code "C")
(setq result
(strcat result "⌀")
)
)

;; %%u → 下線指定
;; プレーンテキストなので無視
((= code "U")
nil
)

;; %%o → 上線指定
;; プレーンテキストなので無視
((= code "O")
nil
)

;; %%% → %
((= code "%")
(setq result
(strcat result "%")
)
)

;; その他
(T
(setq result
(strcat result "%%" code)
)
)
)

(setq i (+ i 3))
)

;; "%" が単独の場合
(progn
(setq result
(strcat result ch)
)
(setq i (1+ i))
)
)
)


;; ========================================================
;; 通常文字
;; ========================================================

(T

(setq result
(strcat result ch)
)

(setq i (1+ i))
)
)
)

result
)


;;; ------------------------------------------------------------
;;; オブジェクトから文字列を取得
;;; ------------------------------------------------------------

(defun GetObjectTextString
(obj / name)

(setq name
(vla-get-ObjectName obj)
)

(cond

;; MText
((= name "AcDbMText")
(vla-get-TextString obj)
)

;; TEXT
((= name "AcDbText")
(vla-get-TextString obj)
)

;; MLeader
((= name "AcDbMLeader")
(vla-get-TextString obj)
)

;; Dimension
((wcmatch name "AcDb*Dimension")
(vla-get-TextOverride obj)
)

;; 対象外
(T nil)
)
)


;;; ------------------------------------------------------------
;;; オブジェクトへ文字列を書き戻す
;;; ------------------------------------------------------------

(defun SetObjectTextString
(obj str / name)

(setq name
(vla-get-ObjectName obj)
)

(cond

;; MText
((= name "AcDbMText")
(vla-put-TextString obj str)
T
)

;; TEXT
((= name "AcDbText")
(vla-put-TextString obj str)
T
)

;; MLeader
((= name "AcDbMLeader")
(vla-put-TextString obj str)
T
)

;; Dimension
((wcmatch name "AcDb*Dimension")
(vla-put-TextOverride obj str)
T
)

;; 対象外
(T nil)
)
)


;;; ------------------------------------------------------------
;;; コマンド PLAIN
;;; ------------------------------------------------------------

(defun c:PLAIN
(/ ent obj old new)

(vl-load-com)

(prompt
"\nMText / 寸法 / TEXT / MLeader を選択: "
)

(while
(setq ent (entsel))

(setq obj
(vlax-ename->vla-object
(car ent)
)
)

(setq old
(GetObjectTextString obj)
)

(if old

(progn

(setq new
(RemoveMTextFormat old)
)

(if
(/= old new)

(progn

(SetObjectTextString obj new)

(princ
(strcat
"\n変換前: "
old
"\n変換後: "
new
)
)
)

(princ
"\n書式コードはありません。"
)
)
)

(princ
"\nこのオブジェクトは対象外です。"
)
)
)

(princ)
)


(princ
"\nPLAIN コマンドが使用できます。"
)

(princ)

ささぐりーん様
ありがとうございます

正常に作動しました