;2026/03/20
;----------僨傿僕僞僀僘抐柺(Digitizing.lsp)

;(R)=ARES







  ;******************* 婙忋偘暥帤崅傪巜掕乮扨埵丗mm)
  (Defun C:SetTHeight ()
  ;*******************;2025/08/01
    (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)
  );----------------------------------


  ;******************* 摍崅慄崅偺扨埵傪巜掕乮扨埵丗mm)
  (Defun C:Digits ()
  ;*******************;2026/03/14
    (if (getenv "digits")
      (setq digits (getString 
              (strcat "\n摍崅慄崅偺彫悢揰昞帵 <" (getenv "digits") ">:")))
      (setq digits (getString 
              (strcat "\n摍崅慄崅偺彫悢揰昞帵 < >:")))
    );if
    (if (= "" digits)
      (setq digits (getenv "digits"));Enter/嬻懪--->廬慜抣嵦梡
    );if
    (setenv "digits" digits)
    (princ)
  );----------------------------------











  ;******************* 抐柺巒揰P1乮栴帇嵍抂乯傪巜掕
  (Defun C:GetpointPt1 ( / Xp Yp Pt  )
  ;*******************;2026/03/14
    (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")
    ;+++++++
    (if (getenv "Pt1")
      (setq Pt1 (getstring 
                  (strcat "\n巒揰乮栴帇嵍抂乯柤傪擖椡<" (getenv "Pt1") ">:")))              
      (setq Pt1 (getstring 
                  (strcat "\n巒揰乮栴帇嵍抂乯柤傪擖椡< >:"))) 
    )
    (if (= "" Pt1)
      (setq Pt1 (getenv "Pt1"));Enter/嬻懪--->廬慜抣嵦梡
    )
    (setenv "Pt1" Pt1)
    ;+++++++
    (AdjustmentUnit);扨埵挷惍僒僽儖乕僠儞
    ;+++++++
    (RegistRowsRate);峴娫妘挷惍僒僽儖乕僠儞
    ;+++++++
    (command "Ucs" "w" "-MText" "@" "J" "ML" "H" (rtos Tsize)  "L" "A" 峴娫妘 "@0,0"
          Pt1 (Strcat "X1=" Xp) (Strcat "Y1=" Yp) "")
    (command "Ucs" "p")
    (setVar "Textsize" Textsize)
    (princ)
  );----------------------------------






  ;******************* 抐柺廔揰乮栴帇塃抂乯傪巜掕
  (Defun C:GetpointPt2 ( / Xp Yp Pt  )
  ;*******************;2026/03/14
    (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 "Pt2")
      (setq Pt2 (getstring 
                  (strcat "\n廔揰乮栴帇塃抂乯柤傪擖椡<" (getenv "Pt2") ">:")))              
      (setq Pt2 (getstring 
                  (strcat "\n廔揰乮栴帇塃抂乯柤傪擖椡< >:"))) 
    )
    (if (= "" Pt2)
      (setq Pt2 (getenv "Pt2"));Enter/嬻懪--->廬慜抣嵦梡
    )
    (setenv "Pt2" Pt2)
    ;+++++++
    (AdjustmentUnit);扨埵挷惍僒僽儖乕僠儞
    ;+++++++
    (RegistRowsRate);峴娫妘挷惍僒僽儖乕僠儞
    ;+++++++

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





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


  ;******************* 僒僽儖乕僠儞
  (Defun SubGetpointPtz ( / Xp Yp MyPt Zp )
  ;*******************;2026/03/14
    (setq Textsize (getVar "Textsize"));暥帤僒僀僘
    (setq Tsize (* (atof (Getenv "攞棪")) (atof (Getenv "THeight"))))
    (setq Pt1 (getenv "Pt1"))
    (setq Pt2 (getenv "Pt2"))
    ;(setq digits (getenv "digits"))
    ;+++++++
    (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 Pt1 "-" Pt2) (Strcat "X=" Xp) (Strcat "Y=" Yp) (Strcat "Z=" Zp) "")
    (command "Ucs" "p")
    (setq Zp (+ (atof (Getenv "嚈")) (atof Zp)))
    (setEnv "崅偝Z" (rtos Zp))
    ;(setEnv "崅偝Z" (rtos Zp 2 (atoi digits)))
    (setVar "Textsize" Textsize)

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





  ;******************* 嵗昗抣暥帤楍傪僥僉僗僩僼傽僀儖偵偟偰彂偒弌偡
  (defun C:TransmitDigitizeContour ( / Eset cnt num Tmpl Ed  Org 
                                            Ofile FileID MyData MyText)
  ;*******************;2025/08/01
    (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 )
  ;*******************;2025/08/01
    ;(Setenv "SCRyn" "N")
    (setq pt nil)
    (setq SCRyn (getstring 
        (strcat "\n僨傿僕僞僀僘抐柺嶌恾幚峴偟傑偡偐丠[ Y:偼偄/N:偄偄偊 ]<" 
                                                    (Getenv "SCRyn") ">:")))
    (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 ( /   )
  ;*******************;2026/03/14
    ;+++++++慺抧
    (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 ( /   )
  ;*******************;2025/08/01
    ;+++++++
    (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)
  );------------







