;----------座標値計測旗上げ(FlagID.lsp)

;(R)=ARES



;<---2026/03/20
;<---2025/07/07
;<---2024/07/07
;<---2024/02/19
;<---2024/02/05
;<---2023/06/06
;<---2021/06/18




  ;*******************旗上げスタイル
  (defun C:FlagIDstyle ( / Pyn Zyn  )
  ;*******************2026/03/20
    ;--------------------------------------測点名P 表示登録
    (if (Getenv "Pyn")
      (setq Pyn (getstring 
              (strcat "\n測点名Pn [ Y:表記あり/N:表記なし ] <" (Getenv "Pyn") ">:")))
      (setq Pyn (getstring 
              (strcat "\n測点名Pn [ Y:表記あり/N:表記なし ] < >:")))
    )
    (if (= "" Pyn)
      (setq Pyn (Getenv "Pyn"));Enter/空打--->従前値採用
    )
    (Setenv "Pyn" Pyn);<---扱いは文字列（数字は扱えない:NG）
    ;--------------------------------------高さZ 表示登録
    (if (Getenv "Zyn")
      (setq Zyn (getstring 
              (strcat "\n高さZn [ Y:表記あり/N:表記なし ] <" (Getenv "Zyn") ">:")))
      (setq Zyn (getstring 
              (strcat "\n高さZn [ Y:表記あり/N:表記なし ] < >:")))
    )
    (if (= "" Zyn)
      (setq Zyn (Getenv "Zyn"));Enter/空打--->従前値採用
    )
    (Setenv "Zyn" Zyn)
    (princ)
  );----------





  ;*******************測点名Pnを入力
  (defun C:FlagIDPn ( / Pyn MyPt  )
  ;*******************2026/03/20
    (if (equal (strcase (Getenv "Pyn")) "Y")
      (progn
        (if (Getenv "MyPt")
          (setq MyPt (getstring (strcat "\n測点名Pnを入力<" (Getenv "MyPt") ">:")))              
          (setq MyPt (getstring (strcat "\n測点名Pnを入力< >:"))) 
        )
        (if (= "" MyPt)
          (setq MyPt (Getenv "MyPt"));Enter/空打--->従前値採用
        )
        (Setenv "MyPt" MyPt)
      );progn
      (setq Dummy (getstring (strcat "\n測点名Pn[ N:表記なし ]:")))
    )
    (princ)
  );----------








  ;*******************高さZnを入力
  (defun C:FlagIDZn ( / Zyn MyZp  )
  ;*******************2026/03/20
    (if (equal (strcase(Getenv "Zyn")) "Y")
      (progn
        (if (Getenv "MyZp")
          (setq MyZp (getstring (strcat "\n高さZnを入力<" (Getenv "MyZp") ">:")))               
          (setq MyZp (getstring (strcat "\n高さZnを入力< >:"))) 
        )
        (if (= "" MyZp)
          (setq MyZp (Getenv "MyZp"));Enter/空打--->従前値採用
        )
        (Setenv "MyZp" MyZp)
      );progn
      (setq Dummy (getstring (strcat "\n高さZn[ N:表記なし ]:")))
    )
    (princ)
  );----------






  ;**************** 行間隔の尺度
  (defun C:RowsSpace ( / Obj Ent )
  ;****************2026/03/20
    (if (Getenv "行間隔")
      (setq 行間隔 (getstring (strcat "\n行間隔尺度<" (Getenv "行間隔") ">:")))
      (setq 行間隔 (getstring (strcat "\n行間隔尺度< >:"))))
    (if (= "" 行間隔)
      (setq 行間隔 (Getenv "行間隔")));Enter/空打--->従前値採用
    (Setenv "行間隔" 行間隔);
    (princ)
  );----------











  ;*******************座標値を引出線で旗上げ
  (defun C:FlagID ( / Xp Yp MyPt MyZp )
  ;*******************2026/03/20
    (Command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt (getpoint "\n計測する位置を指定:"))
    (Command "ID" Pt)
    (Command "Grips" "2")
    ;+++++++
    (AdjustmentUnit);単位調整サブルーチン
    ;+++++++
    (setq Pyn (strcase(getenv "Pyn")))
    (setq Zyn (strcase(getenv "Zyn")))
    (setq MyVal 0)
    (if (equal Pyn "Y")
        (setq MyVal (+ MyVal 1))
    )
    (if (equal Zyn "Y")
        (setq MyVal (+ MyVal 2))
    )
    (setq MyPt (Getenv "MyPt"))
    (setq MyZp (Getenv "MyZp"))
    (cond	
      ((Equal MyVal 3)
        (Command "Ucs" "w" "Leader" "@" "_non" Pause "a" 
            (Strcat "" MyPt ) 
            (Strcat "X=" Xp) (Strcat "Y=" Yp) 
            (Strcat "Z=" MyZp) ""))	
      ((Equal MyVal 2)
        (setq MyPt "")
        (Command "Ucs" "w" "Leader" "@" "_non" Pause "a" 
            (Strcat "X=" Xp) (Strcat "Y=" Yp)
            (Strcat "Z=" MyZp) ""))	
      ((Equal MyVal 1)
        (setq MyZp "")
        (Command "Ucs" "w" "Leader" "@" "_non" Pause "a" 
            (Strcat "" MyPt )
            (Strcat "X=" Xp) (Strcat "Y=" Yp) ""))		
      (T
        (setq MyPt "")
        (setq MyZp "")
        (Command "Ucs" "w" "Leader" "@" "_non" Pause "a" 
            (Strcat "X=" Xp) (Strcat "Y=" Yp) ""))		
    );cond
    (Command "Grips" "2")	
    (Command "Ucs" "p")
    ;-------------
    (setq TextObj (ssget "_L"))
    (setq MyEnt (ssname TextObj 0))
    (setq Ent (entget MyEnt))
    ;-------------
    (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
    ;--------TextObj 40 の情報（文字高）を書き換え
    (setq Ent (subst (cons 40 (getvar "Textsize")) (assoc 40 Ent) Ent)) 
    (entmod Ent);TextObjのDXF図形情報書き換え
    ;--------TextObj 44 の情報（行間尺度）を書き換え
    ;(RegistRowsRate);行間隔調整サブルーチン
    (setq Ent (subst (cons 44 (atof (Getenv "行間隔"))) (assoc 44 Ent) Ent))
    ;(setq Ent (subst (cons 44 0.75) (assoc 44 Ent) Ent))   
    (entmod Ent);TextObjのDXF図形情報書き換え
    ;--------
    (Command "Grips" "2")	
    (princ)
  ;テキストファイルを書き出す
    (if (setq FileID (open "C:/MyCANAL/Supply/Text/FlagID.csv" "w")) ;書込みモードで開く  
      (progn   ;もしファイルを開けたら 
        (setq Pt (Strcat MyPt "," Xp "," Yp "," MyZp))
        ;+++++++++++++++++++++++++++++
        (write-line Pt FileID) 
        ;+++++++++++++++++++++++++++++               
        (close FileID)
      );progn
    );if
    (princ)
  );----------






  ;*******************作図基点を指定して座標値を旗上げ
  (Defun C:NoneFlagID ( / Xp Yp MyPt MyZp )
  ;*******************2026/03/20
    ;(setq Tsize (*  (getVar "DimTxt") (getVar "DimScale")));文字サイズ
    (setq Tsize   (getvar "Textsize") );文字サイズ
    (command "OsnapCoord" "1" "-Layer" "M" "FlagID" "" )
    (setq Pt (getpoint "\n座標値計測<計測する位置を指定>:"))
    (command "ID" Pt)
    (command "Grips" "2")
    ;+++++++
    (AdjustmentUnit);単位調整サブルーチン
    ;+++++++
    (setq MyText (strcat "X=" Xp "\\P"  "Y=" Yp))
    ;+++++++
    (RegistRowsRate);行間隔調整サブルーチン
    ;+++++++
    (setq Pyn (strcase(getenv "Pyn")))
    (setq Zyn (strcase(getenv "Zyn")))
    (setq MyVal 0)
    (If (equal Pyn "Y")
        (setq MyVal (+ MyVal 1)))
    (If (equal Zyn "Y")
        (setq MyVal (+ MyVal 2)))
    (setq MyPt (Getenv "MyPt"))
    (setq MyZp (Getenv "MyZp"))
    (cond	
      ((equal MyVal 3)
          (command "Ucs" "w" "-MText" "@" "J" (getenv "文字位置") "H" (rtos Tsize) "L" "A" 行間隔 "@0,0" 
              (strcat "" MyPt ) 
              (strcat "X=" Xp) (strcat "Y=" Yp) 
              (strcat "Z=" MyZp) ""))
      ((equal MyVal 2)
          (setq MyPt "")
          (command "Ucs" "w" "-MText" "@" "J" (getenv "文字位置") "H" (rtos Tsize) "L" "A" 行間隔 "@0,0" 
              (Strcat "X=" Xp) (Strcat "Y=" Yp) 
              (strcat "Z=" MyZp) ""))
      ((equal MyVal 1)
          (setq MyZp "")
          (command "Ucs" "w" "-MText" "@" "J" (getenv "文字位置") "H" (rtos Tsize) "L" "A" 行間隔 "@0,0" 
              (strcat "" MyPt ) 
              (strcat "X=" Xp) (strcat "Y=" Yp) ""))		
      (T
          (setq MyPt "")
          (setq MyZp "")
          (command "Ucs" "w" "-MText" "@" "J" (getenv "文字位置") "H" (rtos Tsize) "L" "A" 行間隔 "@0,0"  
              (strcat "X=" Xp) (strcat "Y=" Yp) ""))
    );cond	
    (command "Ucs" "p")

  ;テキストファイルを書き出す
    (if (setq FileID (open "C:/MyCANAL/Supply/Text/FlagID.csv" "w")) ;書込みモードで開く  
      (progn   ;もしファイルを開けたら 
        (setq Pt (strcat MyPt "," Xp "," Yp "," MyZp))
        ;+++++++++++++++++++++++++++++
        (write-line Pt FileID) 
        ;+++++++++++++++++++++++++++++               
        (close FileID)
      );progn
    );if
    (princ)
  );----------





  ;*******************  ;単位調整サブルーチン
  (Defun AdjustmentUnit ( /   )
  ;*******************2026/03/20
    ;+++++++素地
    (setq Xp (rtos (car (getvar "Lastpoint"))))
    (setq Yp (rtos (cadr (getvar "Lastpoint"))))
    (Setenv "X1o" Xp)
    (Setenv "Y1o" Yp)
    ;+++++++作図単位による調整
    (setq Xp (rtos (* (atof Xp) (atof (getenv "係数")))))
    (setq Yp (rtos (* (atof Yp) (atof (getenv "係数")))))
    ;+++++++小数点揃え
    (setq Xp (rtos (atof Xp) 2 (atoi (getenv "小数点"))))
    (setq Yp (rtos (atof Yp) 2 (atoi (getenv "小数点"))))
    ;+++++++
    (princ)
  );------------




  ;******************* ;行間隔調整サブルーチン
  (Defun RegistRowsRate ( /   )
  ;*******************2026/03/20
    (setq 行間隔 (Getenv "行間隔"))
    (if (= 行間隔 nil);・・・Pn が nil のとき
      (progn
        (Setenv "行間隔" "0.75")
        (setq 行間隔 "0.75x")
      );progn
      (progn
        (if  (OR (< (atof 行間隔) 0.25) (> (atof 行間隔) 4.00))
          (progn
            (setenv "行間隔" "0.75")
            (setq 行間隔 "0.75x")
          );progn
          (setq 行間隔 (strcat 行間隔 "x"))
        );if
      );progn
    );if
    ;+++++++
    (princ)
  );------------

