AutoCADマクロ屋本舗 掲示板

またお願いしたいのですが文字回転移動のマクロをlispに移行できるでしょうか？
常に多用しているコマンドなのでできれば助かります。

https://ameblo.jp/totthi-macro/entry-11079087518.html

マクロ
*^C^C$M=setenv;to;0;$(nth,$(getenv,to),;sw;0;;to;1,offset;;^X単一文字選択【$(if,$(getenv,sw),COPY,MOVE)】［切替(R-Click)］^X\$M="""$(if,$(getvar,cmdactive),;setenv;to;2,setenv;sw;$(if,$(getenv,sw),0,1);;to;1)""",,,,)$(nth,$(getenv,to),,,;to;1;select;non;@;non;@;;explode;@;$M="""$(if,$(getvar,cmdactive),;,)"""ucs;ob;@;copybase;non;@;@;;ucs;p;setenv;p1;$(getvar,lastpoint);;to;3,,,)$(nth,$(getenv,to),,,,offset;;^X角度合せｵﾌﾞｼﾞｪｸﾄ指定^X\;setenv;to;3;select;non;@;non;@;;setenv;to;4,,)$(nth,$(getenv,to),,,,,$(if,$(getenv,sw),,erase;$(getenv,p1);;)ucs;ob;non;$(getvar,lastpoint);ucs;z;$m="""$(if,$(>,0.001,$(index,1,$(getvar,ucsydir))),180,0)""";setenv;to;5,)$(nth,$(getenv,to),,,,,,pasteclip;non;$(getvar,viewctr);ucs;p;;p;ucs;ob;@;id;non;0","0;ucs;p;copybase;non;@;L;;erase;p;;pasteclip;\setenv;to;1)^M

そのままの機能で良いなら、そのマクロを使えば良いと思います。
なぜ、LISPにする必要が有るのでしょうか？

とりあえず、LISPにしてみましたが、そのマクロと同じ手順ではないかもしれません。（そのマクロを使用したことがないので）
注意！　現在のUCSがワールドの時にしか使えません。（ワールド以外にも対応するのが面倒だったので）

LISP起動　⇒　コマンドラインで（copy/moveのモード確認）
右クリックする度にcopy/moveのモードが切り替わるので、希望のモードの時に文字をクリック。
角度を合わせたい線をクリックして、文字の挿入位置をクリック

(defun C:Txt_Rotate_Move_Copy ( / TRM_MODE ent entb obj)
(if (getenv "TRM_MODE") (setq TRM_MODE (getenv "TRM_MODE")) (progn (setenv "TRM_MODE" "Copy") (setq TRM_MODE "Copy")))
(while (not (setq ent (entsel (strcat "\n文字を選択してください（" (getenv "TRM_MODE") " モード）: "))))
(if (= "Copy" (getenv "TRM_MODE"))
(progn (setenv "TRM_MODE" "Move") (setq TRM_MODE "Move"))
(progn (setenv "TRM_MODE" "Copy") (setq TRM_MODE "Copy"))
)
)
(setq obj (cdr (assoc 0 (entget (car ent)))))
(if (eq obj "TEXT")
(progn
(setq entl (entlast))
(command "ucs" "ob" (car ent) "copybase" "non" "0,0" (car ent) "" "ucs" "p")
(if (setq entb (nentsel "\n合わせ線を選択してください: "))
(progn
(command "ucs" "ob" entb)
(setq kakudo (* (angle (trans '(0 0 0) 1 2) (trans '(1 0 0) 1 2)) (/ 180.0 pi)))
(if (and (> 271 kakudo) (< 91 kakudo)) (setq kakudo (+ 180 kakudo)))
(command "ucs" "p")
(command "pasteclip" "r" (rtos kakudo 2 2) pause)
(if (eq TRM_MODE "Move") (entdel (car ent)))
)
)
)
(alert "選択したオブジェクトは文字ではありません。")
)
(princ)
)

ありがとうございます。
希望通りのLISPでした。