AutoCADマクロ屋本舗 掲示板

Autocad2014を使用しています。
文字二重線付加 Ver.2017　を　一本線にするのは出来るでしょうか？
マクロの中身が複雑すぎて自分ではカスタムが無理でした。orz

こちらの事かな？

https://totthi.bbs.fc2.com/?act=reply&tid=16449591

2014とのことなのでもしかしたらlengthenコマンドの仕様が違うかもしれません
『lengthen;dy;;;l;;;』を『lengthen;l;;』に変更してお試しください(2ヶ所有るのでご注意を)

それでもエラーが出たら下記参考に再度質問してください

３．バージョン違いによるマクロの動作不良の場合は、キーボードF2を押し、表示されたテキストウィンドウ内の
　　マクロ開始～終了までのマクロの流れをコピーし、貼り付けてご質問下さい。

確認不足でした
文字二重線付加マクロだけで過去質問のマクロを紹介してしまいました

とってぃさんのマクロを修正するとこんな感じです

*^C^C$m=setenv;to;0;$(nth,$(getenv,to),offset;;\;select;non;@;non;@;;copy;p;;non;@;non;@;erase;p;;undo;be;setenv;to;1;-attedit;y;;;;non;@;non;@;;$M="""$(if,$(getvar,cmdactive),;setenv;to;0,)""",,,,,)$(nth,$(getenv,to),,;to;2;explode;l;"""$m=$(if,$(getvar,cmdactive),;)"""explode;l;"""""""$m=$(if,$(getvar,cmdactive),;)"""""""select;l;,,,,)$(nth,$(getenv,to),,,;to;3;ucs;e;l;sortents;127;line;non;@;non;@0.05<0;;extend;p;;f;non;@-0.02",0.1;non;@0,-0.2;;f;non;@-0.02,0.1;non;@0,"-0.2;;,,,)$(nth,$(getenv,to),,,,;to;4;line;non;@;non;@0.05<90;;extend;p;;f;non;@0.1",-0.02;non;@-0.2,0;;f;non;@0.1,-0.02;non;@-0.2,"0;;;lengthen;dy;;;l;;;ucs;e;l;erase;l;,,)$(nth,$(getenv,to),,,,,chprop;l;;c;1;;move;p;;non;@-0.05<0;non;$(*,$(getvar,perimeter),0.5)<0;ucs;p;;p;copybase;0<0;p;l;;undo;e;u;pasteclip;non;0<0)^M

こちらも下記の可能性はあります
2014とのことなのでもしかしたらlengthenコマンドの仕様が違うかもしれません
『lengthen;dy;;;l;;;』を『lengthen;l;;』に変更してお試しください

>>chibi-tom様
　lengthen;l;;に置換える事で2014でも完璧に動作しました。
　時間のある時に自分なりにどう修正したのか勉強してみようと思います。
　本当にありがとうございました。　

お世話になっております。

当方IJ CAD　LTですが、二重線のマクロをLISPで作りました。
ご質問ですが、二重線の基点を取得していますがそれが左下となり文字の中央振り分けができません。水平の場合は文字高さを2で割った位置に座標を取得して可能ですが、傾いた文字の場合うまくできません。ご教示お願い致します。


(progn (while (setq sourceobj (entget (car (entsel "select text"))))(setq var1 (cdr (assoc 40 sourceobj)))(setq var2 (cdr (assoc 51 sourceobj)))(setq var3 (cdr (assoc 1 sourceobj)))(setq var4 (strlen var3))(setq var6 (cdr (assoc 41 sourceobj)))(setq var8 (angtos (cdr (assoc 50 sourceobj))))(setq var5 (* var1 var4 var6))(setq pt1 (cdr (assoc 10 sourceobj)))(setq var9 (/ var1 2))(setq pt1x (car pt1) pt1y (+ var9 (cadr pt1)))(setq pt2 (list pt1x pt1y))(command "line" pt1 "a" var8 var5 "")(command "offset" "E" "Y" (/ var1 2) "l" "B" ""))(command "offset" "E" "Y" (/ var1 3) "l" "B" ""))(princ))

まず、カッコの数が合っていません。
(command "offset" "E" "Y" (/ var1 2) "l" "B" "")
の後ろに余分な　) が付いています。

そこを修正して使ってみたところ、水平・垂直・斜め、どの文字でも同じように線が引かれます。
（画像参照）

希望としては、どの様に線を引いて欲しいのでしょうか？
画像を添付してくれると判りやすいです。

修正ありがとうございます。

希望としては文字の中央から分割した2重線を引きたいです。（イメージ添付）
文字が傾いた場合も中央の座標を取得してラインを引く、それを両側オフセット、オフセットのもとを消す。です。

また追加の希望でマルチテキストにも対応させたいです。

こんな感じですか？

(progn (while (setq sourceobj (entget (car (entsel "select text"))))(setq var1 (cdr (assoc 40 sourceobj)))(setq var2 (cdr (assoc 51 sourceobj)))(setq var3 (cdr (assoc 1 sourceobj)))(setq var4 (strlen var3))(setq var6 (cdr (assoc 41 sourceobj)))(setq var8 (angtos (cdr (assoc 50 sourceobj))))(setq var5 (* var1 var4 var6))(setq pt1 (cdr (assoc 10 sourceobj)))(setq var9 (/ var1 2))(setq pt1x (car pt1) pt1y (+ var9 (cadr pt1)))(setq pt2 (list pt1x pt1y))(command "line" pt1 "a" var8 var5 "")(command "offset" "E" "Y" (/ var1 2) "l" "B" "")(command "erase" "l" "")(command "offset" "E" "Y" (/ var1 3) "l" "B" ""))(princ))

マルチテキストの場合は、考えるのが面倒なので、しばらく保留。

ありがとうございます。思い通りに動きました。
基点からオフセットして、eraseで片側を消してセンターだけ残して両側オフセットは考えつかなかったです。