;----------;クリックした点の座標値（X,Y,Z)をテキストファイルに抽出する(CANAL-TransferID.lsp)

;(R)=ARES
;<--------------2025/06/25
;<--------------2022/11/25


;*******************
(Defun C:TransferID ( / Pt Xp Yp Zp FileID )
;*******************
  (setenv "Result" "FALSE")
  (setq Pt (getpoint "\n計測点を指定:"))
  (Command "ID" Pt)
  (Command "Grips" "2")
  ;+++++ 素地
  (Setq Xp (rtos (car (GetVar "Lastpoint"))))
  (Setq Yp (rtos (cadr (GetVar "Lastpoint"))))
  (Setq Zp (rtos (caddr (GetVar "Lastpoint"))))
  ;-------------------作図単位による調整
  (setq Xp (rtos (* (atof Xp) (atof (getenv "係数")))))
  (setq Yp (rtos (* (atof Yp) (atof (getenv "係数")))))
  (setq Zp (rtos (* (atof Zp) (atof (getenv "係数")))))
  ;+++++
  (princ)
  
;テキストファイルを書き出す
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/TransferID.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (setq Pt (strcat Xp "," Yp "," Zp))
      ;+++++++++++++++++++++++++++++
      (write-line Pt FileID) 
      ;+++++++++++++++++++++++++++++               
      (close FileID)
		  (setenv "Result" "TRUE")
    );progn
  );if

  ;(Command "script" "C:/MyCANAL/Supply/scr/App_TransferID.scr")



  (princ)
  ;+++++
);--------------------------------






;*****************;クリックした点の座標値（X,Y,Z)をテキストファイルに抽出する
(defun C:xTransferID ( / Ofile Fw MyData MyText)
;*****************
;テキストファイルを書き出す
  (setenv "Result" "FALSE")
  (setq Ofile "C:/MyCANAL/Supply/Text/TransferID.csv")
  (setq Fw (open Ofile "w")) ;ファイルオープン
  (if (= Fw nil)
    (alert "\nファイルが見当たりません。")
    (progn
	  	(setq Pt (getpoint "\n計測点を指定:"))
    	(Command "ID" Pt)
  		(Command "Grips" "2")
	 	  ;+++++ 素地
  		(setq Xp (rtos (car (getvar "Lastpoint"))))
    	(setq Yp (rtos (cadr (getvar "Lastpoint"))))
  		(setq Zp (rtos (caddr (getvar "Lastpoint"))))
  	  ;-------------------作図単位による調整
    	(setq Xp (rtos (* (atof Xp) (atof (getenv "係数")))))
  		(setq Yp (rtos (* (atof Yp) (atof (getenv "係数")))))
  		(setq Zp (rtos (* (atof Zp) (atof (getenv "係数")))))
  		;+++++
		  (setq MyText (strcat Xp "," Yp "," Zp))
      (write-line MyText Fw)
      ;----------------
      (close Fw)
      (setenv "Result" "TRUE")
    );progn
  );if
  (princ)
)











