AutoCADマクロ屋本舗 掲示板

はじめまして、以前、DenさんのHPで公開されていた以下のマクロを、
IJCAD2023STDで用いたいのですが、マクロ化もしくは、Lisp化できますでしょうか？
IJCADでsetenv、getenvが使用できないのは、IJCADのHPで掲示されていたので、
宜しくお願い致します。

％勾配記入
*^C^Cucs;ob;^X^X【線分中心より左側をｸﾘｯｸ】^X\id;mid;@;-text;j;bc;non;@0,$M=$(*,$(getvar,dimgap),3,$(getvar,dimscale));$(*,$(getvar,dimtxt),$(getvar,dimscale));0;$(rtos,$(*,$(/,$(index,1,$(getvar,ucsxdir)),$(index,0,$(getvar,ucsxdir)),$(if,$(>=,0,$(index,1,$(getvar,ucsxdir))),-1,1)),100,$(getvar,dimlfac)),2,3)%;leader;non;@$(*,$(getvar,dimtxt),$(getvar,dimscale),3.5,$(if,$(>=,0,$(index,1,$(getvar,ucsxdir))),1,-1)),-$(*,$(getvar,dimgap),$(getvar,dimscale));non;@$(*,$(getvar,dimtxt),$(getvar,dimscale),3.5,$(if,$(>=,0,$(index,1,$(getvar,ucsxdir))),-2,2)),0;;;n;ucs;p;

法勾配記入
*^C^Cucs;ob;^X^X【線分中心より左側をｸﾘｯｸ】^X\id;mid;@;$M=-text;j;bc;non;@0,$(*,$(getvar,dimscale),0.5);$(*,$(getvar,dimtxt),$(getvar,dimscale));0;1:$(rtos,$(/,$(index,0,$(getvar,ucsxdir)),$(index,1,$(getvar,ucsxdir)),$(getvar,dimlfac),$(if,$(>=,0,$(index,1,$(getvar,ucsxdir))),-1,1)),2,$(getenv,keta));ucs;p;^C^C

面積算出
*^C^C-layer;m;D-Area;c;magenta;;;area;o;\text;@;;;$M=$(rtos,$(*,$(/,$(getvar,area),$(getenv,mm),$(getenv,mm)),$(getvar,dimlfac)),2,3)m2;move;last;;@;\line;@;\;

宜しくお願いします。

いずれも、縦横比が、異なる際に、寸法スタイル(縦方向をn倍)依存で、表記をさせるものです。

tabが無くなって見にくいけど、我慢して下さいm(__)m

矢印付きパーセント勾配をD-STR-DIM画層に作成
(defun c:d-dimpkoubai( / )
(command "_ucs" "W") ;UCSワールド
(if (= ikei nil) (setq ikei 2))
(setq msgtxt (strcat "\n　\n異縮尺を使う？[Yes(1)/No(2)] <" (rtos ikei 2 0) ">: "))
(setq kari (getint msgtxt)) (if (/= kari nil) (setq ikei kari))
(if (= pketa nil) (setq pketa 3))
(setq msgtxt (strcat "\n小数点桁数は？[0～4] <" (rtos pketa 2 0) ">] "))
(setq kari (getint msgtxt)) (if (/= kari nil) (setq pketa kari))
(setq dims (getvar "dimscale"))
(setq txts (getvar "textsize"))
(setq dimlf (getvar "dimlfac"))
(if (= ikei 2) (setq dimlf 1))
(setq clay (getvar "clayer"))
(setq hanare (* (getvar "DIMGAP") 2 dims)) ;矢印の離れはDIMGAPの２倍
(setq hanare (list 0 hanare))
(while (setq ss (entsel "\n路面左側を指示 <終了>: "))
(setq p0 (cadr ss)) ;指示点
(command "line" "endp" p0 "mid" p0 "") ;端点と中点に線分作成
(command "lengthen" "last" "") ;長さ計測
(setq L1 (getvar "perimeter")) ;端点と中点の距離
(command "erase" "last" "") ;線分消去
(setq osm (getvar "OSMODE")) ;osモード取得
(setvar "OSMODE" 0) ;osnap無し
(command "layer" "m" "D-STR-DIM" "") ;画層移動(作成)
(command "ucs" "object" p0 )
(if (/= 0 (nth 1 (getvar "ucsxdir")))
(progn (setq txt (abs (* (/ (nth 1 (getvar "ucsxdir")) (nth 0 (getvar "ucsxdir"))) 100)))
(setq txt (strcat (rtos (* txt dimlf) 2 pketa) "%"))
(command "ucs" "m" (list L1 0))
(command "ucs" "m" hanare)
(command "text" "bc" "0,0" "" "0" txt)
(setq naga0 (+ (strlen txt) 3))
(setq naga1 (/ (* naga0 txts -0.65) 2))
(setq naga2 (/ (* naga0 txts 0.65) 2))
(setq p1 (list naga1 0)) (setq p2 (list naga2 0))
(command "leader" p1 p2 "" "" "n")
(if (> 0 (nth 1 (getvar "ucsxdir")))
(command "rotate" "si" "last" "0,0" "180")))
(progn (command "ucs" "m" "mid" (getvar "lastpoint"))
(command "ucs" "m" hanare)
(command "text" "bc" "0,0" "" "0" "i=LEVEL")
(setq naga1 (* 5 txts -0.65))
(setq naga2 (* 5 txts 0.65))
(setq p1 (list naga1 0)) (setq p2 (list naga2 0))
(command "leader" p1 p2 "" "" "n")
(command "leader" p2 p1 "" "" "n")))
(setvar "clayer" clay) ;レイヤを戻す
(setvar "osmode" osm) ;OSモードを戻す
(command "_ucs" "W") (princ) ;UCSワールド
)
(princ)
)

法勾配をD-STR-DIM画層に作成
(defun c:d-dimnkoubai( / )
(if (= ikei nil) (setq ikei 2))
(if (= nketa nil) (setq nketa 1))
(command "_ucs" "W") ;UCSワールド
(setq msgtxt (strcat "\n　\n異縮尺を使う？[Yes(1)/No(2)] <" (rtos ikei 2 0) ">: "))
(setq kari (getint msgtxt)) (if (/= kari nil) (setq ikei kari))

(setq msgtxt (strcat "\n小数点桁数は？[0～4] <" (rtos nketa 2 0) ">: "))
(setq kari (getint msgtxt)) (if (/= kari nil) (setq nketa kari))

(setq dims (getvar "dimscale"))
(setq txts (getvar "textsize"))
(setq dimlf (getvar "dimlfac"))
(if (= ikei 2) (setq dimlf 1))
(setq hanare (* (getvar "DIMGAP") dims)) ;離れはDIMGAP
(setq clay (getvar "clayer"))
(setq osm (getvar "OSMODE")) ;osモード取得
(while (setq ss (entsel "\n法面左側を指示 <終了>: "))
(setq p0 (cadr ss)) ;指示点
(command "line" "endp" p0 "mid" p0 "") ;端点と中点に線分作成
(command "lengthen" "last" "") ;長さ計測
(setq L1 (getvar "perimeter")) ;端点と中点の距離
(command "erase" "last" "") ;線分消去
(setvar "OSMODE" 0) ;osnap無し
(command "layer" "m" "D-STR-DIM" "") ;画層移動(作成)
(command "ucs" "ob" p0)
(if (/= 0 (nth 1 (getvar "ucsxdir")))
(progn (setq txt (abs (/ (nth 0 (getvar "ucsxdir")) (nth 1 (getvar "ucsxdir")))))
(setq txt (strcat "1:" (rtos (* txt dimlf) 2 nketa))))
(setq txt "LEVEL"))
(command "ucs" "m" (list L1 hanare))
(command "text" "bc" "0,0" "" "0" txt)
(setvar "clayer" clay) ;レイヤを戻す
(setvar "OSMODE" osm) ;OSモードを戻す
(command "_ucs" "W") (princ) ;UCSワールド
)
(princ)
)

ポリライン面積測定・書込み
※現在の寸法スタイル名に「M」があると作図単位はＭと判断します
　画層の変更は上記のLISPを参考にして下さい。
(defun c:d-menseki1( / )
(if (= keta nil) (setq keta 1))
(setq dims (getvar "dimscale"))
(setq diml (getvar "dimlfac"))
(setq msgtxt (strcat "\n　\n小数点桁数は？[0～3] <" (rtos keta 2 0) ">: "))
(setq kari (getint msgtxt)) (if (/= kari nil) (setq keta kari))
(setq dimnamae (getvar "dimstyle")) ;寸法スタイル名
(while (setq ss (entsel "\nポリラインを選択 <終了>: "))
(setq p1 (cadr ss)) ;指示点
(command "area" "o" p1)
(if (/= (vl-string-search "M" dimnamae) nil)
(setq atai (* (/ (getvar "area") 1) diml diml)) ;Ｍ単位の面積
(setq atai (* (/ (getvar "area") 1000000) diml diml))) ;mm単位の面積
(setq atai (rtos atai 2 keta))
(setq p1 (getpoint "\n引出し位置を指示: "))
(setq p2 (getpoint p1 "\n数値位置を指示: "))
(command "line" "non" p1 "non" p2 "")
(if (< (cadr p1) (cadr p2)) (setq iti "b") (setq iti "t"))
(if (< (car p1) (car p2)) (setq yoko "l") (setq yoko "r"))
(setq iti (strcat iti yoko))
(command "text" iti "non" "@" "" "0" atai)
(princ))
(princ)
)

Den 様

早々(深夜)の対応ありがとうございます。

ご教授に感謝いたします。
早速、作図されている図面にて確認させていただきました。

％勾配表記、問題なく用いることができました。※そのまま使用させていただきます。

法勾配1：1.8(AutoCAD)(V=1:200,H=1:1000　m作図【単位管理】)で、
異縮尺を使う？[Yes(1)]とした場合、1：0.1(寸法スタイル1:200のもの)、
[No(2)]とした場合、1：0.4(寸法スタイル1:200のもの)になりました。

面積表示は、文字表示されるのですが、\n小数点桁数1で　「0.0」、小数点桁数3で、　「0.000」となりました。

掲載のコードをベースに、自分で勉強して頑張ってみます。

解決(完結)　としてください。

報告までに、
横方向が基準長さにしていたので、
法勾配をD-STR-DIM画層に作成については
、

最下段から9行上の
(setq txt (strcat "1:" (rtos (* txt dimlf) 2 nketa))))　を

(setq txt (strcat "1:" (rtos (/ txt dimlf) 2 nketa))))　にしたら、問題なく表示できました。