;平均断面法土積
;クリックした点に面積値を表示










;*******************;Jun.01.2025
(Defun C:BoundaryAreaB()
;*******************
  (setq Textsize (getVar "Textsize"));文字サイズ
  (setq Tsize (* (atof (Getenv "倍率")) (atof (Getenv "THeight"))))
  ;+++++++
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaB" "C" "1" "" "" )
  (setq Pt (getpoint "\n<盛土断面Bを指定>:"))
  (Command "ID" Pt)
  (Command "Grips" "2")
  ;-------------------素地
  (setq Xp (rtos (car (getvar "Lastpoint"))))
  (setq Yp (rtos (cadr (getvar "Lastpoint"))))
  (setq 基点 (strcat Xp "," Yp))
  ;-------------------
  (Command "Boundary" "@" "")  
  (Command "Area" "O" "L")
  (setq MyArea (rtos(getvar "Area")))  
  ;-------------------作図単位による調整
  (setq MyArea (rtos (* (atof MyArea) (atof (getenv "面積係数")))))
  ;-------------------小数点揃え
  (setq MyArea (rtos (atof MyArea) 2 (atoi (getenv "小数点"))))
  ;-------------------Tsi
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaText"  "" )
  (command "-MText" 基点 "j" "MC" "H" (rtos Tsize) "@0,0"
           (strcat "B:" MyArea) "")
  (setVar "Textsize" Textsize)
  (princ)
);----------------------------------




;******************* 
(Defun C:BoundaryAreaC()
;*******************
  (setq Textsize (getVar "Textsize"));文字サイズ
  (setq Tsize (* (atof (Getenv "倍率")) (atof (Getenv "THeight"))))
  ;+++++++
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaC" "C" "150" "" "" )
  (setq Pt (getpoint "\n<切土断面Cを指定>:"))
  (Command "ID" Pt)
  (Command "Grips" "2")
  ;-------------------素地
  (setq Xp (rtos (car (getvar "Lastpoint"))))
  (setq Yp (rtos (cadr (getvar "Lastpoint"))))
  (setq 基点 (strcat Xp "," Yp))
  ;-------------------
  (Command "Boundary" "@" "")  
  (Command "Area" "O" "L")
  (setq MyArea (rtos(getvar "Area")))  
  ;-------------------作図単位による調整
  (setq MyArea (rtos (* (atof MyArea) (atof (getenv "面積係数")))))
  ;-------------------小数点揃え
  (setq MyArea (rtos (atof MyArea) 2 (atoi (getenv "小数点"))))
  ;-------------------
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaText"  "" )
  (command "-MText" 基点 "j" "MC" "H" (rtos Tsize)  "@0,0"
           (strcat "C:" MyArea) "")
  (setVar "Textsize" Textsize)
  (princ)
);----------------------------------



;******************* 
(Defun C:BoundaryAreaR()
;*******************
  (setq Textsize (getVar "Textsize"));文字サイズ
  (setq Tsize (* (atof (Getenv "倍率")) (atof (Getenv "THeight"))))
  ;+++++++
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaR" "C" "84" "" "" )
  (setq Pt (getpoint "\n<埋戻断面Rを指定>:"))
  (Command "ID" Pt)
  (Command "Grips" "2")
  ;-------------------素地
  (setq Xp (rtos (car (getvar "Lastpoint"))))
  (setq Yp (rtos (cadr (getvar "Lastpoint"))))
  (setq 基点 (strcat Xp "," Yp))
  ;-------------------
  (Command "Boundary" "@" "")  
  (Command "Area" "O" "L")
  (setq MyArea (rtos(getvar "Area")))  
  ;-------------------作図単位による調整
  (setq MyArea (rtos (* (atof MyArea) (atof (getenv "面積係数")))))
  ;-------------------小数点揃え
  (setq MyArea (rtos (atof MyArea) 2 (atoi (getenv "小数点"))))
  ;-------------------
  (Command "OsnapCoord" "1" "-Layer" "M" "AreaText"  "" )
  (command "-MText" 基点 "j" "MC" "H" (rtos Tsize)  "@0,0"
           (strcat "R:" MyArea) "")
  (setVar "Textsize" Textsize)
  (princ)
);----------------------------------





;******************* 文字列をテキストファイルにして書き出す
(Defun C:SelectAreaText()
;*******************
    (if (setq FileID (open "C:/MyCANAL/Supply/Text/SumCuttingFaces.txt" "w")) ;書込みモードで開く  
        (progn   ;もしファイルを開けたら 
            ;+++++++
            (princ "\n<断面積値を選択>")
            (setq Eset(ssget (list (cons 0 "MTEXT"))));マルチテキスト選択
            (setq cnt 0)
            (setq num (sslength Eset))
            ;+++++++
            (while (< cnt num);
                (setq Tmpl (ssname Eset cnt))
                (setq Ed (entget Tmpl))
                (setq Org (cdr(assoc 1 Ed)))
                (setq MyHandle  (cdr (assoc 5 Ed)));ハンドル名
                ;+++++++
                (setq MyData  Org)
                (write-line MyData FileID) 				
                ;+++++++
                (setq cnt (+ 1 cnt))
            );while 
            (close FileID);ファイルを閉じる 
            ;(command-s "Layuniso")
            (alert "断面積値 転送完了")
        );progn
        (alert "\nファイルが見当たりません。") ;エラーメッセージ 
    );if
    (princ)
);----------------------------------














