CODE20：選択した円の面積を一括表記

2023年05月16日

2023年06月22日


;選択した円の面積を一括表記;+++++++++++++
(defun C:CODE20 (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++
    (princ "\n円を選択")
    (setq Obj (ssget (list (cons 0 "CIRCLE"))))
    (if (not(= Obj nil));円が選択されたら・・・
        (progn
            (setq cnt 0
                    num (sslength Obj))
            ;------------
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagArea" "")
            ;------------
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ed (entget tmpl))
                (setq MyHandle  (cdr (assoc 5 ed)));ハンドル名
                ;-----円の中心座標
                (setq Pt (cdr(assoc 10 ed)));
                (Command "Area" "o" (handent MyHandle)  "")
                (setq ObjArea (getvar "Area"))
                (Command
                    "ID" Pt
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "A=" (rtos ObjArea)) ""
                    "Ucs" "p"
                    "Grips" "2"
                )	
                (setq cnt (1+ cnt))
            );while
        );progn
        ;円が選択されていなかったら・・・
        (alert "選択エラー：円が選択されていません") 
    ):if
    (princ)
)