CODE18：選択した円弧の長さを一括表記

2023年05月16日
2023年06月22日

;選択した円弧の長さを一括表記;+++++++++++++
(defun C:CODE18 ( / 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)
            (setq num (sslength Obj))
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagLength" "")
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ed (entget tmpl))
                (setq MyHandle  (cdr (assoc 5 ed)));ハンドル名
                (Command "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                (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 ppnl (assoc 10 pstl))
                    (setq pstl (member ppnl pstl))
                    (setq pstl (cdr pstl))
                    (if (= nc 0)
                        (progn
                            (setq lppnt (list ppnt))
                            (setq SumXp PtX			
                                    SumYp PtY)
                        );progn
                        (progn
                            (setq lppnt (append lppnt (list ppnt)))
                            (setq SumXp (+ SumXp PtX)			
                                    SumYp (+ SumYp PtY))
                        );progn
                    );if
                    (setq nc (+ nc 1))
                );repeat
                ;-----平均座標
                ;+++++++++++++
                (setq PtXm (/ SumXp npsu)
                        PtYm (/ SumYp npsu))
                (setq PtXm (rtos PtXm )
                        PtYm (rtos PtYm ))
                ;+++++++++++++	
                (setq Ptm (strcat PtXm "," PtYm))
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2"
                );Command
                (Command "_Explode" (handent MyHandle)  );ポリライン-->円弧に戻す
                (setq cnt (1+ cnt))
            );while
        );progn
        ;円弧が選択されていなかったら・・・
        (alert "選択エラー：円弧が選択されていません") 
    ):if
    (princ)
)