CODE06：選択したポリラインの頂点座標値を一括表記

2023年05月13日

2023年06月17日


;選択したポリラインの頂点座標値を一括表記
;+++++++++++++
(defun C:CODE06 ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
    (princ "\n最適化ポリラインを選択")
    (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
    ;------------
    (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)
                        ent (entget tmpl))
               ;------------
                (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)))
                    );if
                    (setq nc (+ nc 1))
                );repeat
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されていなかったら・・・
        (alert "選択エラー：最適化ポリラインが選択されていません") 
    ):if
    (princ)
)