AutoCADマクロ屋本舗 掲示板

AutoCAD　2024　を使用してます。

土木図面の座標点をスクリプトファイルで書き出しています。
座標値をマルチ引き出し線で表記したいです。
こちらのサイトでとてもいいものを発見したのですが、スクリプトファイルでは使用できないようです。
直接、点オブジェクトで書いてみると反応するのですが、スクリプトファイル又はCSVファイルもダメでした。
同じ点なのに・・・。どうしてかわかりません。

見つけたものはこちらになります。
(defun c:corval (/ ss inf pt1 pt2 pt_lb pt_rt pt cnt pt_lst pt_w pt_l l_ang l_leng i ent pent pt_ck1 pt_ck2 gap)
(vl-load-com)
(setq pt1 (getpoint "\n窓選択の1点目を指定:"))
(setq pt2 (getcorner pt1 "\n窓選択の2点目を指定:"))
;線、ポリライン、円、円弧、点のみ対象
(setq ss (ssget "C" pt1 pt2 '((0 . "*LINE,CIRCLE,ARC,POINT"))))
;選択範囲の左下と右上座標を作成
(setq pt1 (trans pt1 1 0))
(setq pt2 (trans pt2 1 0))
(setq pt_lb (list (min (car pt1)(car pt2))(min (cadr pt1)(cadr pt2))))
(setq pt_rt (list (max (car pt1)(car pt2))(max (cadr pt1)(cadr pt2))))

;交点リスト作成
(setq pt_lst (LM:intersectionsinset ss))

(setq i 0)
(repeat (sslength ss)
(setq ent (entget (ssname ss i)))
(setq pt (cdr (assoc 10 ent)))
(setq pt (list (car pt) (cadr pt)))
(if (= nil (member pt pt_lst))
(setq pt_lst (cons pt pt_lst))
)

;線の場合、終点取得
(if (wcmatch (cdr (assoc 0 ent)) "LINE")
(progn
(setq pt (cdr (assoc 11 ent)))
(setq pt (list (car pt) (cadr pt)))
(if (= nil (member pt pt_lst))
(setq pt_lst (cons pt pt_lst))
)
)
)

;ポリラインの各頂点（始点除く）
(if (wcmatch (cdr (assoc 0 ent)) "LWPOLYLINE")
(progn
(setq cnt (cdr (assoc 90 ent))) ;頂点数カウント
(setq pent ent)
(repeat (- cnt 1)
(setq pent (cdr (member (assoc 10 pent) pent)))
(setq pt (cdr (assoc 10 pent)))
(if (= nil (member pt pt_lst))
(setq pt_lst (cons pt pt_lst))
)
)
)
)

;円弧の始点・終点
(if (wcmatch (cdr (assoc 0 ent)) "ARC")
(progn
(setq pt (vlax-curve-getstartpoint (ssname ss i)))
(setq pt (list (car pt) (cadr pt)))
(if (= nil (member pt pt_lst))
(setq pt_lst (cons pt pt_lst))
)
(setq pt (vlax-curve-getendpoint (ssname ss i)))
(setq pt (list (car pt) (cadr pt)))
(if (= nil (member pt pt_lst))
(setq pt_lst (cons pt pt_lst))
)
)
)
(setq i (+ 1 i))
)

;座標でソート
(setq pt_lst
(vl-sort pt_lst
'(lambda (a b)
(cond
((< (car a) (car b)))
((= (car a) (car b)) (< (cadr a) (cadr b)))
)
)
)
)

;重複座標チェック
(setq gap (expt 0.1 (+ 1 (getvar "LUPREC"))))
(repeat (length pt_lst)
(setq pt_ck1 (car pt_lst))
(setq pt_ck2 (cadr pt_lst))
(if (equal pt_ck1 pt_ck2 gap)
(setq pt_lst (cdr pt_lst))
(setq pt_lst (append (cdr pt_lst) (list pt_ck1)))
)
)

;引出線の制御点：方向は60度、長さは250に設定
(setq l_ang (* pi (/ 60 180.0)))
(setq l_leng 250)
(foreach pt_w pt_lst
(if (and (>= (car pt_w) (car pt_lb))(>= (cadr pt_w) (cadr pt_lb))
(<= (car pt_w) (car pt_rt))(<= (cadr pt_w) (cadr pt_rt)))
(progn
(setq pt_l (polar pt_W l_ang l_leng))
(command "_ucs" "w" "_leader" pt_w pt_l "A" (strcat "X=" (rtos (car pt_w))) (strcat "Y=" (rtos (cadr pt_w))) "" "_ucs" "p")

)
)
)
(redraw)
(princ)
)

;; Intersections - Lee Mac
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;; mod - [int] acextendoption enum of intersectwith method

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
;(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
(setq rtn (cons (list (car lst) (cadr lst)) rtn)
lst (cdddr lst)
)
)
)
(reverse rtn)
)

;; Intersections in Set - Lee Mac
;; Returns a list of all points of intersection between all objects in a supplied selection set.
;; sel - [sel] Selection Set

(defun LM:intersectionsinset ( sel / id1 id2 ob1 ob2 rtn )
(repeat (setq id1 (sslength sel))
(setq ob1 (vlax-ename->vla-object (ssname sel (setq id1 (1- id1)))))
(repeat (setq id2 id1)
(setq ob2 (vlax-ename->vla-object (ssname sel (setq id2 (1- id2))))
rtn (cons (LM:intersections ob1 ob2 acextendnone) rtn)
)
)
)
(apply 'append (reverse rtn))
)

;; Unique - Lee Mac
;; Returns a list with duplicate elements removed.

(defun LM:Unique ( l )
(if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
　
マルチ引き出し線にはいろいろ設定があると思いますが細かいことは言いません。
表現が上記のlspのような感じになっていればいいです。
よろしくお願いいたします。

>スクリプトファイルでは使用できないようです。
スクリプトで、corvalコマンドが実行できないという事ですか？

普通は、lispで作成したコマンドでもスクリプト内でつかえるはずです。
なので、実行は出来ているが希望通りの動きをしてくれない。って事ですか？
でしたら、原因は選択範囲指定の箇所でしょう。

スクリプトでは、ユーザーの操作を途中に挟むことは出来ませんので。

>直接、点オブジェクトで書いてみると反応するのですが、
この意味が判りません。
逆に、直接書かないのはどんな状況ですか？

>スクリプトファイル又はCSVファイルもダメでした。
CSVファイルをどの様に使用しているのですか？
CSVファイルの中身は何が記述されているのですか？

Hamu様

＞スクリプトで、corvalコマンドが実行できないという事ですか？

corvalコマンドがの実行後のF2はこのようになってます。

コマンド: '_script
コマンド: multiple

繰り返すコマンド名を入力: point

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: -100765770,-1145253330

POINT

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: -100971120,-1145411800

POINT

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: -100978030,-1145452630

POINT

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: -100979720,-1145460230

POINT

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: -100929310,-1145515830

POINT

現在の点表示モード: PDMODE=0 PDSIZE=0.0000
点を指定: *キャンセル*

コマンド: _.QSELECT
5 項目が選択されました。

コマンド: '_.zoom
窓のコーナーを指定、表示倍率を入力(nX または nXP) または
[図面全体(A)/中心点(C)/ダイナミック(D)/オブジェクト範囲(E)/前画面(P)/倍率(S)/窓(W)/選択オブジェクト(O)] <リアル タイム>: _e モデルを再作図中。

コマンド: <グリッド オフ>
コマンド: もう一方のコーナーを指定 または [フェンス(F)/ポリゴン窓(WP)/ポリゴン交差(CP)]:
コマンド: *キャンセル*

コマンド:
コマンド:
コマンド: corval
窓選択の1点目を指定:モデルを再作図中。

窓選択の2点目を指定:_ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: w
コマンド: _leader
引出線の始点を指定:
次の点を指定:
次の点を指定: A
無効な入力です。

次の点を指定: X=-100979720
無効な入力です。

次の点を指定: Y=-1145460230
無効な入力です。

次の点を指定:
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: p
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: w
コマンド: _leader
引出線の始点を指定:
次の点を指定:
次の点を指定: A
無効な入力です。

次の点を指定: X=-100978030
無効な入力です。

次の点を指定: Y=-1145452630
無効な入力です。

次の点を指定:
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: p
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: w
コマンド: _leader
引出線の始点を指定:
次の点を指定:
次の点を指定: A
無効な入力です。

次の点を指定: X=-100971120
無効な入力です。

次の点を指定: Y=-1145411800
無効な入力です。

次の点を指定:
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: p
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: w
コマンド: _leader
引出線の始点を指定:
次の点を指定:
次の点を指定: A
無効な入力です。

次の点を指定: X=-100929310
無効な入力です。

次の点を指定: Y=-1145515830
無効な入力です。

次の点を指定:
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: p
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: w
コマンド: _leader
引出線の始点を指定:
次の点を指定:
次の点を指定: A
無効な入力です。

次の点を指定: X=-100765770
無効な入力です。

次の点を指定: Y=-1145253330
無効な入力です。

次の点を指定:
コマンド: _ucs
現在の UCS 名: *ワールド*
UCS 原点を指定 または [面(F)/名前の付いた UCS(NA)/オブジェクト(OB)/直前(P)/ビュー(V)/ワールド(W)/X/Y/Z/Z 軸(ZA)] <ワールド>: p
コマンド:


>直接、点オブジェクトで書いてみると反応するのですが、
　この意味が判りません。
　　作成→点で書くです。

＞逆に、直接書かないのはどんな状況ですか？
　座標値が複数ありますのでスクリプトにして点を取ってます。

＞CSVファイルの中身は何が記述されているのですか？
　座標値です。

＞CSVファイルをどの様に使用しているのですか？
　座標値をコピー　CADの画面で作成→複数点　これで座標値の点が表示されます。
　

スクリプトということは、複数ファイルを連続処理したいのでしょうか。

連続処理する前提として、
1.Lispのロードをacaddoc.lspを使ってオートロードするか、アプリロードのスタートアップに登録しておく
2.スクリプトは以下のように

パターン1　※実際の窓選択の座標を記入
corval
4262.47,-199898.83
18512.25,-209532.98（最後に改行）

オプション→基本設定→座標入力時の優先度で定常オブジェクトスナップを優先にチェックが付いている場合は、
それぞれの座標値の上に１行入れて、nonを追加してください

パターン2　※スクリプト実行中にそのつど窓選択
corval
~
~（最後に改行）

これで動くはずです。

状況はこんな感じですか？

スクリプトを使って（又はCSVファイルのデータを何かしらの方法で）図面上に点を入力している。

⇒この部分については、とりあえずは問題なく点の入力は出来ている訳ですよね？

その入力した点に座標を引出線で記入したいので、corvalのLISPを使用しているが、なぜかエラーが出る。
スクリプトを使用せずに、普通にコマンド入力した点に対してはエラーは出ない。

って事ですね？

>同じ点なのに・・・。どうしてかわかりません。
同じ感想です。原因は判りません。

で、

スクリプトで点を入力しているなら、点と一緒に引出線も入力すれば良いのでは？
引出線を入力するのは、lisp内では
(command "_ucs" "w" "_leader" pt_w pt_l "A" (strcat "X=" (rtos (car pt_w))) (strcat "Y=" (rtos (cadr pt_w))) "" "_ucs" "p")
この部分です。
ここの部分をスプリプトにすれば良いです。

pt_w⇒スクリプト内で指定している 点を入力するための座標
pt_l⇒@100<60 とか。
(strcat "X=" (rtos (car pt_w)))⇒X=(スクリプト内で指定している 点を入力するためのX座標)
(strcat "Y=" (rtos (cadr pt_w)))⇒Y=(スクリプト内で指定している 点を入力するためのY座標)

といった感じで置き換える。
UCS操作は不要です。

Hamuさんが書かれているように、スクリプトで点を作成しているなら、そこで引出線も作成したほうが良いと思います。

Lisp内の
(command "_ucs" "w" "_leader" pt_w pt_l "A" (strcat "X=" (rtos (car pt_w))) (strcat "Y=" (rtos (cadr pt_w))) "" "_ucs" "p")
ここの部分で、オブジェクトスナップが影響しているみたいなので
(command "_ucs" "w" "_leader" "non" pt_w "non" pt_l "A" (strcat "X=" (rtos (car pt_w))) (strcat "Y=" (rtos (cadr pt_w))) "" "_ucs" "p")
に変更します。

元トピも修正しておきます。(__)

Hamu様　LUNE様　

Hamu様　おっしゃる通りです。
LUNE様 書き換えを用意していただきありがとうございす。

説明が下手な私に付き合っていただきありがとうございました。
思い通りになりました。