AutoCADマクロ屋本舗 掲示板

AutoCAD 2025使用してます。
添付したような寸法になるマクロ及びLPSはないですか？＠500×3＝1500
2段にしなくてもいいです。

マクロでは入力値が取れないので、Lispで。
書き換える寸法値をクリック→単位寸法（添付された図だと500）

元の寸法値と単位寸法は整数限定、割り切れない等は考慮していません。
図のように2行にしています。

(defun c:dimo (/ e ent uni txt val num sent str)
(while (= ent nil)
(prompt "\n書き換える寸法値を選択:")
(setq e (entsel))
(setq ent (entget (car e)))
(if (/= (cdr (assoc 0 ent)) "DIMENSION")
(setq ent nil)
)
)
(setq uni (getint "\n単位寸法を入力:"))
(setq sent (entget (car (nentselp (cadr e)))))
(setq txt (cdr (assoc 1 sent)))
(setq val (atoi (substr txt (+ 2 (vl-string-search ";" txt)))))
(setq num (/ val uni))
(setq str (strcat "@" (itoa uni) "×" (itoa num) "\\X" "=" (itoa val)))
(setq ent (subst (cons 1 str)(assoc 1 ent) ent))
(entmod ent)

(princ)
)

寸法を選択して、「500×3」なら3を入力

※寸法値の上書きではなく、接頭表記の方に記入する様になってます

(defun c:AddPrefix (/ ss gi ent dimValue scaledValue newPrefix entObj)
(vl-load-com)
(princ "\n寸法オブジェクトを一つ選択: ")
(setq ss (ssget ":S:E" '((0 . "DIMENSION"))))
(if ss (setq gi (getint "\n分割数を入力：")))
(if gi
(progn
(setq ent (entget (ssname ss 0)))
(setq dimValue (cdr (assoc 42 ent)))
(setq scaledValue (/ dimValue gi))
(setq newPrefix (strcat "@" (rtos scaledValue 2 4) "×" (rtos gi 2 4) "\\X＝")); 新しい接頭文字
(setq entObj (vlax-ename->vla-object (ssname ss 0)))
(vla-put-TextPrefix entObj newPrefix) ; 接頭文字に追加
)
)
(princ)
)

LUNE様　Hamu様　ありがとうございます。
希望通りのものです。