AutoCADマクロ屋本舗 掲示板

いつもお世話になっております。

最近まで使っていたキリ穴引出線のマクロが2026にバージョンアップしてから使えなくなったことによりLISPに置き換えて作成しておりました。
ブロック内の円にも対応したものを作りたいのですが、ブロック内の時のみループから抜け出せず、ESCすると操作が全て取り消しになってしまって困っております。
vlax-forを使わずに引出線を書くことはできますでしょうか？
よろしくお願いします。

使用CAD：AutoCAD2026

以下がLISPです。

(defun c:kiri ( / Diameter activeDocument utility point1 Obj CuNm activeDocument blockTable block )
(MyerrorStart)
(setq BLN (getstring "\nブロック内の円ですか？　《ESC》で終了\n[<ブロック内>(Y)/ブロック外(N)]　《ESC》で終了 "))
(if (= BLN "Y")
(progn;複数の（）を使うための関数
(princ"\nブロック内の円を選択")

(setq Obj (car (entsel "\nブロックを選択: ")))
(setq CuNm (vla-get-Effectivename (vlax-ename->vla-object Obj)))

(setq activeDocument (vla-get-activedocument (vlax-get-acad-object)))

; ブロック テーブルを取得
(setq blockTable (vla-get-blocks activeDocument))

; CuNm という名前のブロックを取得
(setq block (vla-item blockTable CuNm))
(vlax-for vlaObject block
;直径取得＆書き出し
(setq Diameter (vlax-get-property vlaObject 'Diameter))
(setq Diameter (strcat "φ" (rtos Diameter)))
(setq point1 (getpoint "引出線の1点目（円）を指示"))
(command "_mleader" point1 pause pause Diameter)
)
);progn
(progn;複数の（）を使うための関数

' アクティブ ドキュメントの VLA オブジェクトを取得
(setq activeDocument (vla-get-activedocument (vlax-get-acad-object)))

' ドキュメントの Utilyti オブジェクトを取得
(setq utility (vla-get-utility activeDocument))

' 選択した図形の VLA オブジェクトを取得（変数 vlaObject に設定）
(vla-getentity utility 'vlaObject 'pickedPoint "\nオブジェクトを選択:")

(setq point1 (getpoint "引出線の1点目（円）を指示"))
' 選択した円の Diameter プロパティを取得
(setq Diameter (vlax-get-property vlaObject 'Diameter))
;文字結合
(setq Diameter (strcat "φ" (rtos Diameter)))
(command "_mleader" point1 pause pause Diameter)
);progn
);if
(princ)
(MyerrorEND)
)

これで、ブロック内でも外でも対応できていると思います。

(defun c:kiri ( / ent obj dia Diameter point1)
(while (setq ent (nentsel "\n円を選択してください: "))
(setq obj (vlax-ename->vla-object (car ent)))
(if (eq (vla-get-ObjectName obj) "AcDbCircle")
(progn
(setq dia (vla-get-Diameter obj))
(setq Diameter (strcat "φ" (rtos dia)))
(setq point1 (getpoint "引出線の1点目（円）を指示"))
(command "_mleader" point1 pause pause Diameter)
)
(alert "選択したオブジェクトは円ではありません。")
)
)
(princ)
)

Hamu様

ありがございます。
できました。

凄いスッキリしたコードになったのがビックリです。

あと1点お伺いしてもよろしいでしょうか？

円を2回クリックするのを1回で済ませることはできますでしょうか？（引出線の1点目を無くしたい）


よろしくお願いします。

(defun c:kiri ( / ent obj dia Diameter point1)
(while (setq ent (nentsel "\n円を選択してください: "))
(setq obj (vlax-ename->vla-object (car ent)))
(if (eq (vla-get-ObjectName obj) "AcDbCircle")
(progn
(setq dia (vla-get-Diameter obj))
(setq Diameter (strcat "φ" (rtos dia)))
(command "_mleader" "nea" "@" pause pause Diameter)
)
(alert "選択したオブジェクトは円ではありません。")
)
)
(princ)
)

Hamu様

ありがございます。
円を2度クリックしないのは変わらなかったです。
そして、直径寸法が出なくなってしまいました。

以下コマンドの流れです。


コマンド: KIRI
円を選択してください: _mleader
引出線の矢印の位置を指定 または [文字を入力(T)/引出参照線を指定(L)/内容を指定(C)/オプション(O)] <オプション>: nea どこに @
指定された 点が見つかりません。
入力が無効です。
引出線の矢印の位置を指定 または [文字を入力(T)/引出参照線を指定(L)/内容を指定(C)/オプション(O)] <オプション>:
次の点を指定 または [終了(E)] <終了>:
次の点を指定 または [終了(E)] <終了>: φ135
入力が無効です。
次の点を指定 または [終了(E)] <終了>:

>指定された 点が見つかりません。
ここで空振りしているから正常に動かないのですが、なぜ空振りしているのかが判りません。

私のCADでは正常に動きますので、その状況を再現できず、対策ができません。

Hamu様

ご確認ありがございます。

お忙しい中ご対応いただきありがとうございました。

横からですが、
(command "_mleader" "nea" "@" pause pause Diameter)

この部分を
(command "_mleader" "nea" (cadr ent) pause pause Diameter)
にしてみてはどうでしょう？

LUNE様

ありがございます。
できるようになったのですが残念ながら今度はESCで終わらせるとせっかく記入した引出線が無くなってしまいました。


以下コマンドの流れです。

コマンド: KIRI
円を選択してください: _mleader
引出線の矢印の位置を指定 または [文字を入力(T)/引出参照線を指定(L)/内容を指定(C)/オプション(O)] <オプション>: nea どこに
次の点を指定 または [終了(E)] <終了>:
次の点を指定 または [終了(E)] <終了>:
文字列を入力: φ52.475
コマンド:
円を選択してください: *キャンセル*
._UNDO 現在の設定: 自動 = オン, コントロール = すべて, 合成 = はい, 画層 = はい
取り消す操作の数を入力 または [自動(A)/コントロール(C)/開始(BE)/終了(E)/マーク(M)/後退(B)] <1>: _E ._UNDO 現在の設定: 自動 = オン, コントロール = すべて, 合成 = はい, 画層 = はい
取り消す操作の数を入力 または [自動(A)/コントロール(C)/開始(BE)/終了(E)/マーク(M)/後退(B)] <1>: 1 KIRI2 グループ
*** The user cancelled by pressing Escape *** ユーザーによるキャンセル

ESCでなぜUNDOが発行されるのか、それが謎なんですが・・・

一番上のコードを見ると、独自のエラー処理をされているようですが、Hamuさんが提示されたコードにもエラー処理追加していますか？
追加しているのなら、エラー処理を抜いて、Hamuさんのコード＋私が提示した修正部分のみのコードでやってみてください。

LUNE様

ご確認ありがございます。

基本的には独自のエラーコードを使っておりますが、Hamu様のにはエラーコードを入れずに試しております。

↓このコードのみのLispファイルを作って実行しております。

本LISPの中にc:kiriがあるため c:kiri2 と、ここだけ変えております。

(defun c:kiri2 ( / ent obj dia Diameter point1)
(while (setq ent (nentsel "\n円を選択してください: "))
(setq obj (vlax-ename->vla-object (car ent)))
(if (eq (vla-get-ObjectName obj) "AcDbCircle")
(progn
(setq dia (vla-get-Diameter obj))
(setq Diameter (strcat "φ" (rtos dia)))
(command "_mleader" "nea" (cadr ent) pause pause Diameter)
)
(alert "選択したオブジェクトは円ではありません。")
)
)
(princ)
)

エラー処理が書き換わったままになっている可能性が考えられます。

kiri2のコードの1行目にこのコードを追加してみてください。
(setq *error* nil)

LUNE様

ありがございます。
できました。

ということは、この書き足したコードは常に本LISPの方、kiriにも入れた方がいいということでしょうか？

よろしくお願いします。

>この書き足したコードは常に本LISPの方、kiriにも入れた方がいいということでしょうか？
本LISPの方、kiriというのは、最初に提示されたものですね。

>ESCすると操作が全て取り消しになってしまって困っております。
ということなので、(MyerrorStart) と (MyerrorEND) を削除して、念のため (setq *error* nil) を入れておいた方がよさそうです。

(MyerrorStart) の中で、(setq OldErr *error*) 等で、現在のエラー処理を変数に待避して、(MyerrorEND) で書き戻すようなコードの場合に、コードの最後で(MyerrorEND) が実行されずにエラー処理が元に戻らずそのままになったのかもしれません。
その場合、待避したエラー処理も (MyerrorStart) で定義したものなので、書き戻しても同じになります。

コマンドラインに直接、 (setq *error* nil) と入力して、エラー処理をリセットしてみてはどうでしょう？

LUNE様

>(MyerrorStart) と (MyerrorEND) を削除して、念のため (setq *error* nil) を入れておいた方がよさそうです。
本LISP、そのように対応いたしました。

このあとのご説明が難しくて理解できませんでした。^^;
すみません。

>コマンドラインに直接、 (setq *error* nil) と入力して、エラー処理をリセットしてみてはどうでしょう？
これってこのようなことがいつ起こるかわからないので、そのたびにこのエラー処理をするということでしょうか？

よろしくお願いします。

>これってこのようなことがいつ起こるかわからないので、そのたびにこのエラー処理をするということでしょうか？

独自のエラー処理が中途半端になってしまって、（おそらく(MyerrorStart)だけが実行された状態となった？）今回のような状況になったのだと推察します。
例えば、Lispのデバッグで、途中で止めてしまったとか。

通常、(MyerrorStart) と (MyerrorEND) をセットで実行すれば、このようなことは発生しないと思います。
ただ、発生してしまったら、(setq *error* nil)とすれば、デフォルトのエラー処理に戻せるので、それだけ覚えておかれたらいいと思います。

LUNE様

そう言う事だったんですね。
なんか最近Escすると操作が取り消されて元に戻ってしまうことがあっておかしかったんです。
その原因がやっとわかりました。
自分ではいつそのようなことをしたのかは思い当たらないのですが、またこのような現象が発生したら教えていただいたことを実行したいと思います。

ちなみに、これが原因でパソコンが遅くなる、数秒間止まってしまうと言うことはありますでしょうか？
最近パソコンが壊れて今週の月曜日に買い換えたばかりなのに、今日急に遅くなって10秒くらい止まることが多かったので質問させていただきました。