;----------僨傿僕僞僀僘抐柺(Digitizing.lsp)

;(R)=ARES


;<---2025/08/01
;<---2025/06/03
;<---2025/05/31
;<---2024/02/21
;<---2024/02/15
;<---2023/07/25
;<---2023/07/07






;******************* 婙忋偘暥帤崅傪巜掕乮扨埵丗mm)
(Defun C:SetTHeight ()
;*******************
	(if (getenv "THeight")
		(setq THeight (getString (strcat "\n暥帤崅乮扨埵丗mm乯傪巜掕 <" (getenv "THeight") ">:")))
		(setq THeight (getString (strcat "\n暥帤崅乮扨埵丗mm乯傪巜掕 < >:")))
	);if
	(if (= "" THeight)
		(setq THeight (getenv "THeight"));Enter/嬻懪--->廬慜抣嵦梡
	);if
	(setenv "THeight" THeight)
	(princ)
);----------------------------------



;******************* 抐柺巒揰P1乮栴帇嵍抂乯傪巜掕
(Defun C:GetpointPt1 ( / Xp Yp Pt  )
;*******************
	(setq Textsize (getVar "Textsize"));暥帤僒僀僘
	(setq Tsize (* (atof (Getenv "攞棪")) (atof (Getenv "THeight"))))
	;+++++++
	(command-s "OsnapCoord" "1" "-Layer" "M" "Digitizing" "p" "n" "Digitizing" "" )
	(setq Pt (getpoint "\n<抐柺巒揰乮栴帇嵍抂乯傪巜掕>:"))
	(command-s "ID" Pt)
	(command-s "Grips" "2")
	;+++++++
	(AdjustmentUnit);扨埵挷惍僒僽儖乕僠儞
	;+++++++
	(RegistRowsRate);峴娫妘挷惍僒僽儖乕僠儞
	;+++++++
	(command "Ucs" "w" "-MText" "@" "J" "ML" "H" (rtos Tsize)  "L" "A" 峴娫妘 "@0,0"
				(Strcat "X1=" Xp) (Strcat "Y1=" Yp) "")
	(command "Ucs" "p")
	(setVar "Textsize" Textsize)
	(princ)
);----------------------------------






;******************* 抐柺廔揰乮栴帇塃抂乯傪巜掕
(Defun C:GetpointPt2 ( / Xp Yp Pt  )
;*******************
	(setq Textsize (getVar "Textsize"));暥帤僒僀僘
	(setq Tsize (* (atof (Getenv "攞棪")) (atof (Getenv "THeight"))))
	;+++++++
	(command "OsnapCoord" "1" "-Layer" "M" "Digitizing" "p" "n" "Digitizing" "" )
	(setq Pt (getpoint "\n<抐柺廔揰乮栴帇塃抂乯傪巜掕>:"))
	(command "ID" Pt)
	(command "Grips" "2")
	;+++++++
	(AdjustmentUnit);扨埵挷惍僒僽儖乕僠儞
	;+++++++
	(RegistRowsRate);峴娫妘挷惍僒僽儖乕僠儞
	;+++++++

	(command "Ucs" "w" "-MText" "@" "J" "ML" "H" (rtos Tsize)  "L" "A" 峴娫妘 "@0,0"
				(Strcat "X2=" Xp) (Strcat "Y2=" Yp) "")
	(command "Ucs" "p")
	(setVar "Textsize" Textsize)
	(princ)
);----------------------------------





;******************* 寁應偡傞埵抲傪巜掕
(defun C:GetpointPtz (/ Ent);
;*******************  
  	(while T;柍尷儖乕僾
    	(SubGetpointPtz);僒僽儖乕僠儞
  	)
  	(princ)
);-----------------


;******************* 僒僽儖乕僠儞
(Defun SubGetpointPtz ( / Xp Yp MyPt Zp )
;*******************
	(setq Textsize (getVar "Textsize"));暥帤僒僀僘
	(setq Tsize (* (atof (Getenv "攞棪")) (atof (Getenv "THeight"))))
	;+++++++
	(command "OsnapCoord" "1" "-Layer" "M" "Digitizing" "p" "n" "Digitizing" "" )
	(setq Pt (getpoint "\n<寁應偡傞埵抲傪巜掕>:"))
	(command "ID" Pt)
	(command "Grips" "2")
	;+++++++
	(if (Getenv "崅偝Z")
		(Setq Zp (GetString (Strcat "\n崅偝(Z)傪擖椡 <" (Getenv "崅偝Z") ">:")))
		(Setq Zp (GetString (Strcat "\n崅偝(Z)傪擖椡 < >:")))
	);if
	(if (= "" Zp)
		(Setq Zp (Getenv "崅偝Z"));Enter/嬻懪--->廬慜抣嵦梡
	);if
	(Setenv "崅偝Z" Zp)
	;+++++++
	(AdjustmentUnit);扨埵挷惍
	;+++++++
	(RegistRowsRate);峴娫妘挷惍
	;+++++++
	(command "Ucs" "w" "-MText" "@" "J" "ML" "H" (rtos Tsize)  "L" "A" 峴娫妘 "@0,0"
				(Strcat "X=" Xp) (Strcat "Y=" Yp) (Strcat "Z=" Zp) "")
	(command "Ucs" "p")
	(setq Zp (+ (atof (Getenv "嚈")) (atof Zp)))
	(setEnv "崅偝Z" (rtos Zp))
	(setVar "Textsize" Textsize)

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





;******************* 嵗昗抣暥帤楍傪僥僉僗僩僼傽僀儖偵偟偰彂偒弌偡
(defun C:TransmitDigitizeContour ( / Eset cnt num Tmpl Ed  Org Ofile FileID MyData MyText)
;*******************
	(if (setq FileID (open "C:/MyCANAL/Supply/Text/TransmitDigitize.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)
);----------------------------------









;******************* 僨傿僕僞僀僘抐柺嶌恾Script傪幚峴
(Defun C:RunDigitizeContour ( / SCRyn )
;*******************
	(Setenv "SCRyn" "N")
	(setq pt nil)
	(setq SCRyn (getstring (strcat "\n僨傿僕僞僀僘抐柺嶌恾幚峴偟傑偡偐丠[ Y:偼偄/N:偄偄偊 ] ")))
	(if (= "" SCRyn)
		(setq SCRyn (Getenv "SCRyn"));Enter/嬻懪--->廬慜抣嵦梡
	);if
	(Setenv "SCRyn" SCRyn);<---埖偄偼暥帤楍乮悢帤偼埖偊側偄:NG乯
	(if (Or (equal SCRyn "Y") (equal SCRyn "y"))
		(progn
			(setq pt (Getpoint "\n<嶌恾婎揰傪巜掕>"))
			(if (/= pt nil )
				(progn
					(Command "Base" pt "")
					(Command "Script" "C:/MyCANAL/MyScript.scr")
				);progn
			);if
		);progn
	);if
	(princ)
);----------------------------------




;******************* ;扨埵挷惍僒僽儖乕僠儞
(Defun AdjustmentUnit ( /   )
;*******************
	;+++++++慺抧
	(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 ( /   )
;*******************
	;+++++++
	(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)
);------------

