;選択した線分の長さを一括表記
;+++++++++++++
(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 MyEnt (ssname Obj cnt))
                (setq Ent (entget MyEnt))
                (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
                ;-----始点座標
                (setq Pt (cdr(assoc 10 Ent)))
                (setq Pt (trans Pt  MyEnt 0));OCS座標からWCS座標に変換
                (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                (setq PtX1 (car Pt)
                        PtY1 (cadr Pt))		
                ;-----終点座標
                (setq Pt (cdr(Assoc 11 Ent)))
                (setq Pt (trans Pt  MyEnt 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)
)



;線分の長さを求める
;+++++++++++++
(defun C:Code14mm (/ 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"))
                ;+++++++++++++
                (setq ObjLength (/ ObjLength 1000))
                ;+++++++++++++
                (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)
)




;選択したポリラインの全長を一括表記
;+++++++++++++
(defun C:CODE15 ( / Obj cnt num tmpl ent PtX PtY Pt )
;+++++++++++++
    (princ "\nLWPOLYLINEを選択")
    (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
    (if (not(= Obj nil));最適化ポリラインが選択されていたら・・・
        (progn
            (setq cnt 0
                    num (sslength Obj))
            ;------------
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagLength" "")
            ;------------
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ent (entget tmpl))
                (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 "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2");
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されていなかったら・・・
        (alert "選択エラー：最適化ポリラインが選択されていません") 
    ):if
    (princ)
)


;選択したポリラインの長さを一括表記
;+++++++++++++
(defun C:Code15mm ( / Obj cnt num tmpl ent PtX PtY Pt )
;+++++++++++++
    (princ "\nLWPOLYLINEを選択")
    (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
    (if (not(= Obj nil));最適化ポリラインが選択されていたら・・・
        (progn
            (setq cnt 0
                    num (sslength Obj))
            ;------------
            (Command "OsnapCoord" "1" "-Layer" "M" "FlagLength" "")
            ;------------
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ent (entget tmpl))
                (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 "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                ;+++++++++++++
                (setq ObjLength (/ ObjLength 1000))
                ;+++++++++++++    
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2");
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されていなかったら・・・
        (alert "選択エラー：最適化ポリラインが選択されていません") 
    ):if
    (princ)
)



;選択したポリラインの個別辺長を一括表記
;+++++++++++++
(defun C:CODE16 ()
;+++++++++++++
  (princ "\nLWPOLYLINEを選択")
  (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
  (if (not(= Obj nil));最適化ポリラインが選択されていたら・・・
    (progn
      (setq cnt 0)
      (setq num (sslength Obj))
      ;------
      (Command "OsnapCoord" "1" "-Layer" "M" "FlagLength" "")
      ;------
      (while (< cnt num);
        (setq MyEnt (ssname Obj cnt))
        (setq Ent (entget MyEnt))
        (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
        (setq MyFlag  (cdr (assoc 70 Ent)));ポリライン フラグ
        ;------
        (setq npsu (cdr (assoc 90 Ent));頂点数
                Pnt Ent
                nc 0)
        (repeat npsu;頂点数
          (setq Pt (cdr (assoc 10 Pnt));LWPOLYLINEの頂点座標を取得
                Pt (trans Pt  MyEnt 0);OCS座標からWCS座標に変換
                Pt (trans Pt  0 1);WCS座標からUCS座標に変換
                )      
          ;------ 
          (setq Ptx (car Pt)
                Pty (cadr Pt))
          (setq MyPnt (assoc 10 Pnt)
                Pnt (member MyPnt Pnt)
                Pnt (cdr Pnt))
          (if (= nc 0)
            (progn
                (setq LastPnt (list Pt))
                  (setq Pt1 Pt			
                          Pt1x Ptx
                          Pt1y Pty)
                  (setq Pt0 Pt;始点定義			
                          Pt0x Ptx
                          Pt0y Pty)
            );progn
            
            (progn;nc<>0
              (setq LastPnt (append LastPnt (list Pt)))
              (setq Pt2 Pt			
                      Pt2x Ptx
                      Pt2y Pty)
              ;中点座標
              ;+++++++++++++
              (setq PtXm (/ (+ Pt1x Pt2x) 2)
                      PtYm (/ (+ Pt1y Pt2y) 2))                          
              (setq PtXm (rtos PtXm )
                      PtYm (rtos PtYm ))
              ;+++++++++++++	

              (setq Ptm (strcat PtXm "," PtYm))
              (setq ObjLength (distance Pt1 Pt2))    
              (Command
                  "ID" Ptm
                  "Ucs" "w" 
                  "-MText"  "@"  "J" "BC" "@0,0" (Strcat  (rtos ObjLength)) ""
                  "Ucs" "p"
                  "Grips" "2"
              );Command	
              (setq Pt1 Pt			
                      Pt1x Ptx
                      Pt1y Pty)
            );progn
          );if
          (setq nc (+ nc 1))
        );repeat
        (if (= MyFlag 1);閉じたポリライン
          (progn
            ;中点座標
            ;+++++++++++++
            (setq PtXm (/ (+ Pt1x Pt0x) 2)
                    PtYm (/ (+ Pt1y Pt0y) 2))                              
            (setq PtXm (rtos PtXm )
                    PtYm (rtos PtYm ))
            ;+++++++++++++	
            (setq Ptm (strcat PtXm "," PtYm))
            (setq ObjLength (distance Pt1 Pt0))    
            (Command
                "ID" Ptm
                "Ucs" "w" 
                "-MText"  "@"  "J" "BC" "@0,0"
                (Strcat  (rtos ObjLength)) ""
                "Ucs" "p"
                "Grips" "2");Command	
          );progn
        );if
        (setq cnt (1+ cnt))
      );while
    );progn
    ;最適化ポリラインが選択されていなかったら・・・
    (alert "選択エラー：最適化ポリラインが選択されていません") 
  ):if
  (princ)
)




;選択したポリラインの個別辺長を一括表記
;+++++++++++++
(defun C:CODE16mm (  )
;+++++++++++++
    (princ "\nLWPOLYLINEを選択")
    (setq Obj (ssget (list (cons 0 "LWPOLYLINE"))))
    (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 ent (entget tmpl))
                (setq MyHandle  (cdr (assoc 5 ent)));ハンドル名
                (setq MyFlag  (cdr (assoc 70 ent)));ポリライン フラグ
               ;------
                (setq npsu (cdr (assoc 90 ent));頂点数
                        pstl ent
                        nc 0)
                (repeat npsu;頂点数
                            (setq Pt (cdr (assoc 10 pstl));LWPOLYLINEの頂点座標を取得
                            Pt (trans Pt  tmpl 0);OCS座標からWCS座標に変換
                            Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                    ;------ 
                    (setq Ptx (car Pt)
                            Pty (cadr Pt))
                    (setq ppnl (assoc 10 pstl)
                            pstl (member ppnl pstl)
                            pstl (cdr pstl))
                    (if (= nc 0)
                        (progn
                            (setq lppnt (list ppnt))
                             (setq Pt1 Pt			
                                     Pt1x Ptx
                                     Pt1y Pty)
                             (setq Pt0 Pt			
                                     Pt0x Ptx
                                     Pt0y Pty)
                        );progn
                        (progn
                            (setq lppnt (append lppnt (list ppnt)))
                            (setq Pt2 Pt			
                                    Pt2x Ptx
                                    Pt2y Pty)
                            ;中点座標
                            ;+++++++++++++
                            (setq PtXm (/ (+ Pt1x Pt2x) 2)
                                    PtYm (/ (+ Pt1y Pt2y) 2))                         
                            (setq PtXm (rtos PtXm )
                                    PtYm (rtos PtYm ))
                            ;+++++++++++++	
                            (setq Ptm (strcat PtXm "," PtYm))
                            (setq ObjLength (distance Pt1 Pt2))
                            ;+++++++++++++
                            (setq ObjLength (/ ObjLength 1000))
                            ;+++++++++++++     
                            (Command
                                "ID" Ptm
                                "Ucs" "w" 
                                "-MText"  "@"  "J" "BC" "@0,0" (Strcat  (rtos ObjLength)) ""
                                "Ucs" "p"
                                "Grips" "2"
                            );Command	
                            (setq Pt1 Pt			
                                    Pt1x Ptx
                                    Pt1y Pty)
                        );progn
                    );if
                    (setq nc (+ nc 1))
                );repeat
                (if (= MyFlag 1);閉じたポリライン
                    (progn
                        ;中点座標
                        ;+++++++++++++
                        (setq PtXm (/ (+ Pt1x Pt0x) 2)
                                PtYm (/ (+ Pt1y Pt0y) 2))                                 
                        (setq PtXm (rtos PtXm )
                                PtYm (rtos PtYm ))
                        ;+++++++++++++	
                        (setq Ptm (strcat PtXm "," PtYm))
                        (setq ObjLength (distance Pt1 Pt0))
                        ;+++++++++++++
                        (setq ObjLength (/ ObjLength 1000))
                        ;+++++++++++++     
                        (Command
                            "ID" Ptm
                            "Ucs" "w" 
                            "-MText"  "@"  "J" "BC" "@0,0"
                            (Strcat  (rtos ObjLength)) ""
                            "Ucs" "p"
                            "Grips" "2"
                        );Command	
                    );progn
                );if
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されていなかったら・・・
        (alert "選択エラー：最適化ポリラインが選択されていません") 
    ):if
    (princ)
)




;選択した円の周長を一括表記
;+++++++++++++
(defun C:CODE17 (/ 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" "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)));
                (Command "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                (Command
                    "ID" Pt
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2"
                )	
                (setq cnt (1+ cnt))
            );while

        );progn
        ;円が選択されていなかったら・・・
        (alert "選択エラー：円が選択されていません") 
    ):if
    (princ)
)






;円の周長を一括表記
;+++++++++++++
(defun C:Code17mm ( )
;+++++++++++++
    (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" "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)));
                (Command "lengthen" (handent MyHandle) "p" "100" "")
                (setq ObjLength (getvar "PeriMeter"))
                ;+++++++++++++
                (setq ObjLength (/ ObjLength 1000))
                ;+++++++++++++     
                (Command
                    "ID" Pt
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "L=" (rtos ObjLength)) ""
                    "Ucs" "p"
                    "Grips" "2"
                )	
                (setq cnt (1+ cnt))
            );while

        );progn
        ;円が選択されていなかったら・・・
        (alert "選択エラー：円が選択されていません") 
    ):if
    (princ)
)




;選択した円弧の長さを一括表記
;+++++++++++++
(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)
)





;選択した円弧の長さを一括表記
;+++++++++++++
(defun C:CODE18mm ( )
;+++++++++++++
    (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"))
                ;+++++++++++++
                (setq ObjLength (/ ObjLength 1000))
                ;+++++++++++++     
                (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)
)




;選択したポリラインの面積を一括表記
;+++++++++++++
(defun C:CODE19 ( / Obj cnt num tmpl ent 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" "FlagArea" "")
            ;------------
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ent (entget tmpl))
                (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 "Area" "o" (handent MyHandle) "")
                (setq ObjArea (getvar "Area"))
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "A=" (rtos ObjArea)) ""
                    "Ucs" "p"
                    "Grips" "2"
                );Command	
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されなかったら・・・
        (alert "選択エラー：ポリラインが選択されていません") 
    ):if
    (princ)
)




;選択したポリラインの面積を一括表記
;+++++++++++++
(defun C:CODE19mm ()
;+++++++++++++
    (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" "FlagArea" "")
            ;------------
            (while (< cnt num);
                (setq tmpl (ssname Obj cnt))
                (setq ent (entget tmpl))
                (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 "Area" "o" (handent MyHandle) "")
                (setq ObjArea (getvar "Area"))
                ;+++++++++++++
                (setq ObjArea (/ ObjArea 1000000))
                ;+++++++++++++     
                (Command
                    "ID" Ptm
                    "Ucs" "w" 
                    "-MText"  "@"  "J" "MC" "@0,0"
                    (Strcat "A=" (rtos ObjArea)) ""
                    "Ucs" "p"
                    "Grips" "2"
                );Command	
                (setq cnt (1+ cnt))
            );while
        );progn
        ;最適化ポリラインが選択されなかったら・・・
        (alert "選択エラー：ポリラインが選択されていません") 
    ):if
    (princ)
)





  ;選択した円の面積を一括表記
  ;+++++++++++++
  (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)
  )






;選択した円の面積を一括表記
;+++++++++++++
(defun C:CODE20mm ( )
;+++++++++++++
    (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"))
                ;+++++++++++++
                (setq ObjArea (/ ObjArea 1000000))
                ;+++++++++++++     
                (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)
)





;比例分布による任意点高さの計算と表記
;+++++++++++++
(defun C:CODE21 (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++

    (setq MyTxtH (*  (getVar "DimTxt") (getVar "DimScale")));文字サイズ
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt1 (getpoint "\n1点目を指定："))
    (Command "ID" Pt1)
    (setq Pt1x (nth 0 Pt1))
    (setq Pt1y (nth 1 Pt1))
    (setq Pt1z (getstring "\n1点目高さを入力："))
    (Command "Ucs" "w" 
                   "-MText" "@" "J" "ML" "H" MyTxtH "@0,0" 
                   (Strcat "X="  (rtos Pt1x)) (Strcat "Y=" (rtos Pt1y))  (Strcat "Z=" Pt1z) ""
                  "Grips" "2"	
                  "Ucs" "p")
    ;----
    (setq Pt2 (getpoint "\n2点目を指定："))
    (Command "ID" Pt2)
    (setq Pt2x (nth 0 Pt2))
    (setq Pt2y (nth 1 Pt2))
    (setq Pt2z (getstring "\n2点目高さを入力："))
    (Command "Ucs" "w" 
            "-MText" "@" "J" "ML" "H"  MyTxtH  "@0,0" 
            (Strcat "X="  (rtos Pt2x)) (Strcat "Y=" (rtos Pt2y))  (Strcat "Z=" Pt2z) ""
            "Grips" "2"	
            "Ucs" "p")
    ;----
    (setq Pt (getpoint "\n計測する位置を指定："))
    (Command "ID" Pt)
    (setq Ptx (nth 0 Pt))
    (setq Pty (nth 1 Pt))
    (setq dx (- Pt2x  Pt1x )
            dy (- Pt2y  Pt1y )
            dz (- (atof Pt2z ) (atof Pt1z ))
            Lx (- Ptx Pt1x)
            Ly (- Pty Pt1y))
    (if (/= 0 dx)
        (setq Delta (/ dz dx)
                Ptz (+ (atof Pt1z ) (* Delta Lx)))
        (setq Delta (/ dz dy)
                Ptz (+ (atof Pt1z ) (* Delta Ly)))
    );if
    (Command "Leader" Pt "_non" Pause "a"
            (Strcat "X="  (rtos Ptx)) (Strcat "Y=" (rtos Pty))  (Strcat "Z=" (rtos Ptz)) ""
           "Grips" "2");
    (princ)
)




;比例分布による任意点高さの計算と表記
;+++++++++++++
(defun C:CODE21mm ()
;+++++++++++++
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt1 (getpoint "\n1点目を指定："))
    (Command "ID" Pt1)
    (setq Pt1x (nth 0 Pt1))
    (setq Pt1y (nth 1 Pt1))
    (setq Pt1z (getstring "\n1点目高さを入力："))
    ;+++++++++++++
    (setq Pt1xn (/ Pt1x 1000)
            Pt1yn (/ Pt1y 1000))
    (setq Pt1xn (rtos Pt1xn )
            Pt1yn (rtos Pt1yn ))
    ;+++++++++++++
    (Command "Ucs" "w" 
                   "-MText" "@" "J" "ML" "H" (getVar "Dimtxt") "@0,0" 
                   (Strcat "X="  (rtos Pt1xn)) (Strcat "Y=" (rtos Pt1yn))  (Strcat "Z=" Pt1z) ""
                  "Grips" "2"	
                  "Ucs" "p")
    ;----
    (setq Pt2 (getpoint "\n2点目を指定："))
    (Command "ID" Pt2)
    (setq Pt2x (nth 0 Pt2))
    (setq Pt2y (nth 1 Pt2))
    (setq Pt2z (getstring "\n2点目高さを入力："))
    ;+++++++++++++
    (setq Pt2xn (/ Pt2x 1000)
            Pt2yn (/ Pt2y 1000))
    (setq Pt2xn (rtos Pt2xn )
            Pt2yn (rtos Pt2yn ))
    ;+++++++++++++
    (Command "Ucs" "w" 
            "-MText" "@" "J" "ML" "H" (getVar "Dimtxt") "@0,0" 
            (Strcat "X="  (rtos Pt2xn)) (Strcat "Y=" (rtos Pt2yn))  (Strcat "Z=" Pt2z) ""
            "Grips" "2"	
            "Ucs" "p")
    ;----
    (setq Pt (getpoint "\n計測する位置を指定："))
    (Command "ID" Pt)
    (setq Ptx (nth 0 Pt))
    (setq Pty (nth 1 Pt))
    (setq dx (- Pt2x  Pt1x )
            dy (- Pt2y  Pt1y )
            dz (- (atof Pt2z ) (atof Pt1z ))
            Lx (- Ptx Pt1x)
            Ly (- Pty Pt1y))
    (if (/= 0 dx)
        (setq Delta (/ dz dx)
                Ptz (+ (atof Pt1z ) (* Delta Lx)))
        (setq Delta (/ dz dy)
                Ptz (+ (atof Pt1z ) (* Delta Ly)))
    );if
    (Command "Leader" Pt "_non" Pause "a"
            (Strcat "X="  (rtos Ptx)) (Strcat "Y=" (rtos Pty))  (Strcat "Z=" (rtos Ptz)) ""
           "Grips" "2");
    (princ)
)










































