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

2023年05月13日

2023年06月17日


;選択した円弧の両端点座標値を一括表記
;+++++++++++++
(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)
)