CODE14：選択した線分の長さを一括表記

2023年05月14日

2023年06月22日


;選択した線分の長さを一括表記;+++++++++++++
(defun C:CODE14 (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++
    (princ "\n線分を選択")
    (setq Obj (ssget (list (cons 0 "LINE"))))
    (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)));ハンドル名
                ;-----始点座標
                (setq Pt (cdr(assoc 10 ed)))
                (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                (setq PtX1 (car Pt)
                        PtY1 (cadr Pt))		
                ;-----終点座標
                (setq Pt (cdr(Assoc 11 ed)))
                (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                (setq PtX2 (car Pt)
                        PtY2 (cadr Pt))	
                ;-----中点座標
                ;+++++++++++++
                (setq PtXm (/ (+ PtX1 PtX2) 2)
                        PtYm (/ (+ PtY1 PtY2) 2))
                (setq PtXm (rtos PtXm )
                        PtYm (rtos PtYm ))
                ;+++++++++++++	
                (setq Ptm (strcat PtXm "," PtYm))
                (Command "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "BC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2")	
                (setq cnt (1+ cnt))
            );while
        );progn
        ;線分が選択されていなかったら・・・
        (alert "選択エラー：線分が選択されていません") 
    ):if
    (princ)
)