;図面作図情報
;+++++++++++++
(defun C:CODE00 ()
;+++++++++++++
    ;------ 作図単位登録
    (setq 作図単位m (getstring (strcat "\n作図単位 [ M:メートル/MM:ミリメートル ]:")))
    (if (equal (strcase 作図単位m T) "m")
        (setq 作図単位 1
                係数 1
                面積係数 1
                作図 "m：メートル")
        (setq 作図単位 1000
                係数 0.001
                面積係数 0.000001
                作図 "mm：ミリメートル")
    )
    ;------ 図面縮尺登録
    (setq 図面縮尺 (getstring (strcat "\n図面縮尺 1 / <  >:")))
    ;------ 文字高登録
    (setq 文字高 (getstring (strcat "\n文字高(mm) <  >:")))
    ;------ TextSizeを計算
    (setq 倍率 (* 作図単位 (atof 図面縮尺)  0.001))
    (setvar "TextSize" (* 倍率 (atof 文字高)))
    ;------ Msg
    (alert (strcat "作図単位：[ " 作図 " ]"
                      "\n図面縮尺 S=1：[ " 図面縮尺 " ]"
                      "\n文字高：[ " 文字高 " ] mm"))	
    ;------
    (Princ)
);End
  


;計測した座標値を引出線で旗上げ
  ;+++++++++++++
  (defun C:CODE01 ( / Xp Yp )
  ;+++++++++++++
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "")   
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt
                "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w"
                "Leader" "@" "_non" Pause "a"
                (Strcat "X=" Xp) (Strcat "Y=" Yp) ""   
                "Grips" "2"
                "Ucs" "p")
    (princ)
  )



;計測した座標値を引出線で旗上げ
;+++++++++++++
(defun C:Code01mm ( / Xp Yp )
;+++++++++++++
	(Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "")
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt
                   "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (/ Xp 1000))
    (setq Yp (/ Yp 1000))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w"
                   "Leader" "@" "_non" Pause "a"
                   (Strcat "X=" Xp) (Strcat "Y=" Yp) ""
                   "Grips" "2"
                   "Ucs" "p")
    (princ)
)




  ;計測した座標値を右側に右側に旗上げ
  (Defun C:CODE02a ( / Xp Yp )
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )   
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt)
    (Command "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w" "-MText" "@" "J" "ML"  "@0,0"
                    (Strcat "X=" Xp) (Strcat "Y=" Yp) ""   
                    "Grips" "2"
                    "Ucs" "p")
    (princ)
  )


;計測した座標値を右側に右側に旗上げ
;+++++++++++++
(Defun C:Code02amm ( / Xp Yp )
;+++++++++++++
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt)
    (Command "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (/ Xp 1000))
    (setq Yp (/ Yp 1000))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w" "-MText" "@" "J" "ML" "@0,0"
                   (Strcat "X=" Xp) (Strcat "Y=" Yp) ""
                   "Grips" "2"
                   "Ucs" "p")
    (princ)
)




  ;計測した座標値を左側に旗上げ
  (Defun C:CODE02b ( / Xp Yp )
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )   
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt)
    (Command "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w" "-MText" "@" "J" "MR"  "@0,0"
                    (Strcat "X=" Xp) (Strcat "Y=" Yp) ""   
                    "Grips" "2"
                    "Ucs" "p")
    (princ)
  )



;計測した座標値を左側に旗上げ
;+++++++++++++
(Defun C:Code02bmm ( / Xp Yp )
;+++++++++++++
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt)
    (Command "Grips" "2")
    ;+++++++++++++
    (setq Xp (car (getvar "Lastpoint")))
    (setq Yp (cadr (getvar "Lastpoint")))
    (setq Xp (/ Xp 1000))
    (setq Yp (/ Yp 1000))
    (setq Xp (rtos Xp ))
    (setq Yp (rtos Yp ))
    ;+++++++++++++
    (Command "Ucs" "w" "-MText" "@" "J" "MR"  "@0,0"
                   (Strcat "X=" Xp) (Strcat "Y=" Yp) ""
                   "Grips" "2"
                   "Ucs" "p")
    (princ)
)



  ;断面図の標高値(EL)旗上げ
  (defun C:CODE04 (/ DLPoint)
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagEL" "")
    (Command "Grips" "2");Esc
    (setq DLPoint (getpoint "\nDL点を指定:"))
    (setq DLx (nth 0 DLPoint)
            DLy (nth 1 DLPoint))
    (setq DL値 (getstring "\nDL値を入力："))
    (setq MyPoint (getpoint "\n計測する点を指定:"))
    (setq Px (nth 0 MyPoint)
            Py (nth 1 MyPoint))
    (Command "ID" "@")
    (setq Delta (- Py  DLy ));
    (setq ELy (+ (atof DL値) Delta))
    (setq MyText (strcat "▽" (rtos ELy)))
    (Command "Leader" MyPoint "_non" Pause "a" MyText "")   
    (Command "Grips" "2");Esc
    (princ)
  );End



;断面図の標高値(EL)旗上げ
;+++++++++++++
(defun C:Code04mm (/ DLPoint)
;+++++++++++++
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagEL" "")
    (Command "Grips" "2");Esc
    (setq DLPoint (getpoint "\nDL点を指定:"))
    (setq DLx (nth 0 DLPoint)
            DLy (nth 1 DLPoint))
    (setq DL値 (getstring "\nDL値を入力："))
    (setq MyPoint (getpoint "\n計測する点を指定:"))
    (setq Px (nth 0 MyPoint)
            Py (nth 1 MyPoint))
    (Command "ID" "@")
    (setq Delta (- Py  DLy ));
    ;+++++++++++++
    (setq Delta (/ Delta 1000))
    ;+++++++++++++
    (setq ELy (+ (atof DL値) Delta))
    (setq MyText (strcat "▽" (rtos ELy)))
    (Command "Leader" MyPoint "_non" Pause "a" MyText "")
    (Command "Grips" "2");Esc
    (princ)
);End





;選択した線分の両端点座標値を一括表記
;+++++++++++++
(defun C:CODE05 ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
    (princ "\n線分を選択")
    (setq Obj (ssget (list (cons 0 "LINE"))))
    ;------------
    (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 Pt (cdr(assoc 10 ed)))
                (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 Pt (cdr(Assoc 11 ed)))
                (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 cnt (1+ cnt))
            );while
        );progn
        ;線分が選択されていなかったら・・・
        (alert "選択エラー：線分が選択されていません") 
    ):if
    (princ)
)


;選択した線分の両端点座標値を一括表記
;+++++++++++++
(defun C:Code05mm ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
    (princ "\n線分を選択")
    (setq Obj (ssget (list (cons 0 "LINE"))))
    ;------------
    (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 Pt (cdr(assoc 10 ed)))
                (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                ;+++++++++++++
                (setq PtX (car Pt)
                        PtY (cadr Pt))
                (setq PtXn (/ PtX 1000)
                        PtYn (/ PtY 1000))
                (setq PtX (rtos PtX )
                        PtY (rtos PtY ))
                (setq PtXn (rtos PtXn )
                        PtYn (rtos PtYn ))
                ;+++++++++++++	
                (setq Pt (Strcat PtX "," PtY))
                (Command 
                    "ID" Pt 
                    "Ucs" "w" "-MText" "@" "J" "ML" "@0,0" 
                    (Strcat "X=" PtXn) (Strcat "Y=" PtYn) ""
                    "Ucs" "p"
                )
                ;-----終点
                (setq Pt (cdr(Assoc 11 ed)))
                (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                ;+++++++++++++
                (setq PtX (car Pt)
                        PtY (cadr Pt))
                (setq PtXn (/ PtX 1000)
                        PtYn (/ PtY 1000))
                (setq PtX (rtos PtX )
                        PtY (rtos PtY ))
                (setq PtXn (rtos PtXn )
                        PtYn (rtos PtYn ))
                ;+++++++++++++	
                (setq Pt (Strcat PtX "," PtY))
                (Command 
                    "ID" Pt 
                    "Ucs" "w" "-MText" "@" "J" "ML" "@0,0" 
                    (strcat "X=" PtXn) (strcat "Y=" PtYn) ""
                    "Ucs" "p"
                )
                (setq cnt (1+ cnt))
            );while
        );progn
        ;線分が選択されていなかったら・・・
        (alert "選択エラー：線分が選択されていません") 
    ):if
    (princ)
)





;選択したポリラインの頂点座標値を一括表記
;+++++++++++++
(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 MyEnt (ssname Obj cnt)
                Ent (entget MyEnt))
        ;------------
        (setq npsu (cdr (assoc 90 Ent)));頂点数
        (setq Pnt Ent)
        (setq nc 0)
        (repeat npsu
          (setq Pt (cdr (assoc 10 Pnt)));LWPOLYLINEの頂点座標を取得
          (setq Pt (trans Pt  MyEnt 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 MyPnt (assoc 10 Pnt))
          (setq Pnt (member MyPnt Pnt))
          (setq Pnt (cdr Pnt))
          (if (= nc 0)
              (setq LastPnt (list Pt))
              (setq LastPnt (append LastPnt (list Pt)))
          );if
          (setq nc (+ nc 1))
        );repeat
        (setq cnt (1+ cnt))
      );while
    );progn
    ;最適化ポリラインが選択されていなかったら・・・
    (alert "選択エラー：最適化ポリラインが選択されていません") 
  ):if
  (princ)
)




;選択したポリラインの頂点座標値を一括表記
;+++++++++++++
(defun C:Code06mm ( / 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 PtXn (/ PtX 1000)
                            PtYn (/ PtY 1000))
                    (setq PtX (rtos PtX )
                            PtY (rtos PtY ))
                    (setq PtXn (rtos PtXn )
                            PtYn (rtos PtYn ))
                    ;+++++++++++++	
	      (setq Pt (Strcat PtX "," PtY))
	      (Command 
		"ID" Pt 
		"Ucs" "w" "-MText" "@" "J" "ML" "@0,0"
                           (strcat "X=" PtXn) (strcat "Y=" PtYn) ""
		"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)
)





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







;選択した円弧の両端点座標値を一括表記
;+++++++++++++
(defun C:Code07mm ( )
;+++++++++++++
    (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 PtXn (/ PtX 1000)
                            PtYn (/ PtY 1000))
                    (setq PtX (rtos PtX )
                            PtY (rtos PtY ))
                    (setq PtXn (rtos PtXn )
                            PtYn (rtos PtYn ))
                    ;+++++++++++++	
                    (setq Pt (Strcat PtX "," PtY))
                    (Command 
                        "ID" Pt 
                        "Ucs" "w" "-MText" "@" "J" "ML" "@0,0" 
                        (strcat "X=" PtXn) (strcat "Y=" PtYn) ""
                        "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)
)



;選択した円/円弧の中心座標値を一括表記
;+++++++++++++
(defun C:CODE08 ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++
    (princ "\n円/円弧を選択")
    (setq Obj (ssget '((0 . "CIRCLE,ARC"))))
    (if (not(= Obj nil));円/円弧が選択されていたら・・・
        (progn
            (setq cnt 0)
            (setq num (sslength Obj))
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "")
            (while (< cnt num);
                (setq MyEnt (ssname Obj cnt))
                (setq Ent (entget MyEnt))
                (setq Pt (cdr(assoc 10 Ent)));円の中心
                (setq Pt (trans Pt  MyEnt 0));OCS座標からWCS座標に変換 ;ename-circle
                (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 cnt (1+ cnt))
            );while
        );progn
        ;円/円弧が選択されていなかったら・・・
        (alert "選択エラー：円/円弧が選択されていません") 
    ):if
    (princ)
)



;選択した円/円弧の中心座標値を一括表記
;+++++++++++++
(defun C:Code08mm ( / Obj cnt num tmpl ed PtX PtY Pt )
;+++++++++++++

    (princ "\n円/円弧を選択")
    (setq Obj (ssget (list (cons -4 "<OR")
		      (cons 0 "CIRCLE")
		      (cons 0 "ARC")
		      (cons -4 "OR>"))))
    (if (not(= Obj nil));円/円弧が選択されていたら・・・
        (progn
            (setq cnt 0)
            (setq num (sslength Obj))
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "")
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ed (entget tmpl))
                (setq Pt (cdr(assoc 10 ed)));円の中心
                (setq Pt (trans Pt  tmpl 0));OCS座標からWCS座標に変換 ;ename-circle
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                ;+++++++++++++
                (setq PtX (car Pt)
                        PtY (cadr Pt))
                (setq PtXn (/ PtX 1000)
                        PtYn (/ PtY 1000))
                (setq PtX (rtos PtX )
                        PtY (rtos PtY ))
                (setq PtXn (rtos PtXn )
                        PtYn (rtos PtYn ))
                ;+++++++++++++	
                (setq Pt (strcat PtX "," PtY))
                (Command 
                    "ID" Pt
                    "Ucs" "w" "-MText" "@" "J" "ML" "@0,0" 
                    (strcat "X=" PtXn) (strcat "Y=" PtYn) ""
                    "Ucs" "p")
                (setq cnt (1+ cnt))
            );while
        );progn
        ;円/円弧が選択されていなかったら・・・
        (alert "選択エラー：円/円弧が選択されていません") 
    ):if
    (princ)
)














