AutoCADマクロ屋本舗 掲示板

お世話になります。
以前こちらから、X,Yの座標を引出線で表示させる下記マクロを頂き使用しています。

^C^C(progn (setq pt_w (trans (setq pt_u (getpoint "点を指定：")) 1 0)) (command "_ucs" "w" "_leader" pt_w pause "A" (strcat "X=" (rtos (car pt_w))) (strcat "Y=" (rtos (cadr pt_w))) "" "_ucs" "p" "")(redraw))

そんな中大変横着な話になりますが、
選択した1点だけでなく、図中で選択した範囲の点、端点、中点、交点、中心等、
全てを一気に表示させる事ができたらなぁと思っています。
引き出した座標どうしが重なりあってもかまいません。
出来るようでしたら御対応願います。宜しくお願い致します。

下記の様にAIにお願いしたら、作ってくれました。
試してはいませんので正常動作するのかは不明です。

※線分・円弧・円・ポリラインを対象にしています。そのほかのオブジェクトがあるなら、追加してください。

※座標値を文字記入する様にお願いしてます。
どんな感じで引出線を出すのか判らなかったのと、お願い文を考えるのが面倒だったので。

////////////////AIへのお願い////////////////////////////////////

autolispで以下操作のコードを作成してください

1.複数のオブジェクトを選択し、選択セットAを作る。（オブジェクトは全て同一平面上に存在する）
2.選択セットAの中に、ブロックまたはポリラインが存在したら分解し、選択セットAから除外。分解されたオブジェクトを選択セットAに追加
3.選択セットAの中に、ブロックまたはポリラインが無くなるまで、2.の操作を繰り返し
4.選択セットAの中から、線分、円、円弧、を抽出し、新しく選択セットBを作る。
5.選択セットB内にある、線分と円弧の両端点、中点の座標、円弧と円の中心点座標を全てリスト化する。（円弧の中点は弦の中点ではなく円弧上の中点））
6.選択セットB内にある、全ての線分、円、円弧の交点座標を5.のリストに追加する。
7.リスト内をX座標を基準にソートし、重複する座標はリストから削除する。
8.リスト内の座標を、ワールド座標からUCS座標に変換する。
9.　2.3.の操作で分解されたオブジェクトを分解前に戻す。
10.現在のUCSをワールドにする。
11.リスト内の座標値をその座標位置に文字記入する。
12.　10.で変更したUCSを元に戻す。

////////////////AIからの返事////////////////////////////////////

(defun c:ProcessObjects ()
(setq ssA (ssget))
(setq ssB (ssadd))
(setq coordList '())

(defun DecomposeAndFilter (ss)
(repeat (sslength ss)
(setq ent (ssname ss 0))
(setq entData (entget ent))
(cond
((or (eq (cdr (assoc 0 entData)) "INSERT") (eq (cdr (assoc 0 entData)) "LWPOLYLINE"))
(command "_.explode" ent)
(setq ss (ssdel ent ss))
(setq newSS (ssget "L" '((0 . "*"))))
(repeat (sslength newSS)
(setq newEnt (ssname newSS 0))
(setq ss (ssadd newEnt ss))
(setq newSS (ssdel newEnt newSS))
)
)
)
)
ss
)

(defun ExtractEntities (ss)
(repeat (sslength ss)
(setq ent (ssname ss 0))
(setq entData (entget ent))
(if (member (cdr (assoc 0 entData)) '("LINE" "CIRCLE" "ARC"))
(ssadd ent ssB)
)
)
)

(defun GetCoordinates (ss)
(repeat (sslength ss)
(setq ent (ssname ss 0))
(setq entData (entget ent))
(cond
((eq (cdr (assoc 0 entData)) "LINE")
(setq start (cdr (assoc 10 entData)))
(setq end (cdr (assoc 11 entData)))
(setq mid (mapcar '(lambda (a b) (/ (+ a b) 2.0)) start end))
(setq coordList (append coordList (list start end mid)))
)
((eq (cdr (assoc 0 entData)) "CIRCLE")
(setq center (cdr (assoc 10 entData)))
(setq coordList (append coordList (list center)))
)
((eq (cdr (assoc 0 entData)) "ARC")
(setq center (cdr (assoc 10 entData)))
(setq startAngle (cdr (assoc 50 entData)))
(setq endAngle (cdr (assoc 51 entData)))
(setq radius (cdr (assoc 40 entData)))
(setq midAngle (/ (+ startAngle endAngle) 2.0))
(setq mid (polar center midAngle radius))
(setq start (polar center startAngle radius))
(setq end (polar center endAngle radius))
(setq coordList (append coordList (list center start end mid)))
)
)
)
)

(defun GetIntersections (ss)
(repeat (sslength ss)
(setq ent1 (ssname ss 0))
(repeat (sslength ss)
(setq ent2 (ssname ss 1))
(if (not (eq ent1 ent2))
(setq inter (vlax-invoke (vlax-ename->vla-object ent1) 'IntersectWith (vlax-ename->vla-object ent2) acExtendNone))
(if inter
(setq coordList (append coordList (list inter)))
)
)
)
)
)

(defun RemoveDuplicates (lst)
(setq sortedList (vl-sort lst '(lambda (a b) (< (car a) (car b)))))
(setq uniqueList '())
(setq prev nil)
(foreach coord sortedList
(if (not (equal coord prev))
(setq uniqueList (append uniqueList (list coord)))
)
(setq prev coord)
)
uniqueList
)

(defun ConvertToUCS (lst)
(mapcar 'trans lst (list 1 0 0) (list 0 1 0))
)

(defun AnnotateCoordinates (lst)
(foreach coord lst
(command "_.text" coord 0.2 0 (strcat "(" (rtos (car coord) 2 2) ", " (rtos (cadr coord) 2 2) ")"))
)
)

(setq ssA (DecomposeAndFilter ssA))
(ExtractEntities ssA)
(GetCoordinates ssB)
(GetIntersections ssB)
(setq coordList (RemoveDuplicates coordList))
(setq coordList (ConvertToUCS coordList))
(command "_.ucs" "_world")
(AnnotateCoordinates coordList)
(command "_.ucs" "_prev")
)

お返事有難うございます。LISPというのがやった事が無い作業ですので確認です。
メモ帳を起動→お返事の中からのAIからの返事より下の部分を貼付けて保存→
拡張子をtxtからlspに変換。名前はzahyou.lspにしました
出来上がったファイルをSupportフォルダに入れる。
AutoCADを起動、コマンドにapploadを入力、
Supportフォルダからzahyou.lspを選択してロードまではなんとなくですが、
ここから先はどうするのでしょうか?
よかったら御教授願えますでしょうか?

ロードできたのならコマンドラインに
ProcessObjects
と入力し、オブジェクトを選択する。

(defun AnnotateCoordinates (lst)
(foreach coord lst
(command "_.text" coord 0.2 0 (strcat "(" (rtos (car coord) 2 2) ", " (rtos (cadr coord) 2 2) ")"))
)
)

この部分がテキスト記入なので、ここを引出線記入に変更すれば良い。
例えばこんな感じ？（動作未確認なので信用しないで）

(defun AnnotateCoordinates (lst)
(foreach coord lst
(command "_leader" coord "@100<60" "A" (strcat "X=" (rtos (car coord))) (strcat "Y=" (rtos (cadr coord))) "" )
)
)


それからパッと見で、9番のお願いが入っていない気がします。（入ってるのかな？）
入ってないなら、UNDO開始とUNDO終了を追加して、UNDO終了後に元に戻す処理を追加しないといけません。

お返事有難う御座います。お返事遅くなり申し訳ありません。
コマンドにProcessObjectsと入力しオブジェクトを選択、
認識された数量がでました。
この後Enterキーを打ってみましたが特になにも起こりません。

そうでしたか。動かなくて残念です。

申し訳ありませんが、
私は、どうして動かないか、どこが悪いのかを確かめるつもりも、
動くように改変するつもりもありません。
（とても時間のかかる作業であるだろうし、私の知識では無理かもしれないから）

対象の図形に条件を付けるなら、もっと簡潔なコードになるでしょうから、
エラーが出なくなる（エラーの出る場所が判りやすくなる）でしょう。
例えば、
ブロックは対象外。
ポリラインは対象外。
ポリラインは対象にするが、そのポリラインは全て直線で構成されている。（円弧は含まない）
など。

詳しい条件を提示してAIにお願いすると、良いでしょう。

こちらからサブルーチンをいくつかお借りしました。
https://www.lee-mac.com/

コマンド名はcorvalです。
2次元限定で、対象は、線・２Dポリライン・円・円弧・点、範囲内の端点・頂点・中心・交点の座標を書き込みます。

-------------------------------------------------------
(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)))))
)

-------------------------------------------------------
引出線の設定は、
下記のところの、60と250を書き換えてください。

(setq l_ang (* pi (/ 60 180.0)))
(setq l_leng 250)

＜上記Lispの注記の追加＞
・ブロックとなっているオブジェクトについては、対象外です。
・書き込む座標値については、現在設定されている長さ精度の1/10を誤差としています。
　例：精度が0.01なら、0.001を誤差として判定　1.230と1.231は同じとなります。

通りすがりの人様お返事有難うございます。
無理ですか…、難しい事いってすいませんでした。
御対応頂き有難う御座いました。
ちなみにAIという事でしたが、どこかのサイトがあるのでしょうか?
よかったら教えてください。

LUNE様お返事有難うございます。
凄い、凄い、解決です。有難う御座いました。
大切に使用させて頂きます。

わたしは普通にcopilot使ってます。
（最近のパソコンならwindowsに標準搭載、昔のパソコンならEdgeブラウザの検索画面から利用、
　　またはOffice365を利用しているならアプリ版が使用可能）

その他が良いなら、「AI　ツール　無料」なんかのキーワードで検索したら良いでしょう。
プログラミング系（特にAutoLISP）に強いAIも有ると思います。
そんなAIは日本語に弱い可能性が有りますので、質問を英語で行う必要があるかもしれません。

https://www.youtube.com/watch?v=P6WxuctYeG8&list=PLGHrz63NKuolzPXIxynyMcTC9aiuUm0QU&index=6
こちらでは、Claudeを使ってLisp作成しています。
参考になれば。

・・・私はまだアナログで、検索してますが（苦笑）

通りすがりの人様、LUNE様お返事有難う御座います。
凄いです。
LUNE様がご案内頂いた動画拝見いたしました。
凄い時代ですねぇ～チャットGTPがどうだな言い始めたのそんなに前ではないですねねぇ～
動画内の女性が「意味はわからんけど」って言っていたのが妙に残ります。
通りすがりの人様はAIであそこまで作成できたんですよね、凄い凄い
LUNEさまご自身で作成できるんでよね、凄い
お二人とも以前にもお世話になっていますが、
次回は自分もまずAIにチャレンジしてみます。
ちょっと感動が凄いです。有難う御座いました。