fc2ブログ

CODE07:選択した円弧の両端点座標値を一括表記

2023年05月13日
AutoLISP サンプルコード公開Gallery

;選択した円弧の両端点座標値を一括表記
;+++++++++++++
(defun C:CODE07 ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
(princ "\n円弧を選択:")
(setq Obj (ssget (list (cons 0 "ARC"))))

(if (not(= Obj nil));円弧が選択されていたら・・・
(progn
(setq cnt 0
num (sslength Obj))
(Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "")
(while (< cnt num);
(setq tmpl (ssname Obj cnt))
(setq ed (entget tmpl))
(setq MyHandle (cdr (assoc 5 ed)));ハンドル名

(Command "Pedit" (handent MyHandle) "" "");円弧-->ポリライン
(setq Ent (entget (entlast)));最後に選択したオブジェクト
(setq tmpl (cdr (assoc -1 Ent)))
(setq MyHandle (cdr (assoc 5 Ent)));ハンドル名

(setq npsu (cdr (assoc 90 Ent)));頂点数
(setq pstl Ent)
(setq nc 0)
(repeat npsu;頂点数
(setq Pt (cdr (assoc 10 pstl)));LWPOLYLINEの頂点座標を取得
(setq Pt (trans Pt tmpl 0));OCS座標からWCS座標に変換
(setq Pt (trans Pt 0 1));WCS座標からUCS座標に変換
;+++++++++++++
(setq PtX (car Pt)
PtY (cadr Pt))
(setq PtX (rtos PtX )
PtY (rtos PtY ))
;+++++++++++++
(setq Pt (Strcat PtX "," PtY))
(Command
"ID" Pt
"Ucs" "w" "-MText" "@" "J" "ML" "@0,0"
(strcat "X=" PtX) (strcat "Y=" PtY) ""
"Ucs" "p")
(setq ppnl (assoc 10 pstl))
(setq pstl (member ppnl pstl))
(setq pstl (cdr pstl))
(if (= nc 0)
(setq lppnt (list ppnt))
(setq lppnt (append lppnt (list ppnt))))
(setq nc (+ nc 1))
);repeat
(Command "_Explode" (handent MyHandle) "" );ポリライン-->円弧に戻す
(setq cnt (1+ cnt))
);while
);progn
;円弧が選択されていなかったら・・・
(alert "選択エラー:円弧が選択されていません")
):if
(princ)
)


 AutoLispサンプルコードプログラム 一覧(インデックス)

 AutoLispサンプルコードプログラム 【概説】

AutoLispサンプルコードプログラム
関連記事
スポンサーサイト



Gallery担当:山野 ロザリア平久郎
Posted by Gallery担当:山野 ロザリア平久郎