fc2ブログ

CODE05:選択した線分の両端点座標値を一括表記

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

;選択した線分の両端点座標値を一括表記
;+++++++++++++
(defun C:CODE05 ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
(princ "\n線分を選択")
(setq Obj (ssget (list (cons 0 "LINE"))))
;------------
(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 Pt (cdr(assoc 10 ed)))
(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 Pt (cdr(Assoc 11 ed)))
(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 cnt (1+ cnt))
);while
);progn
;線分が選択されていなかったら・・・
(alert "選択エラー:線分が選択されていません")
):if
(princ)
)


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

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

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



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