;;; ------------------------------------------------------------------
;;; XTD-IIC.LSP - xuat toa do diem trong AutoCAD
;;; Vien Tin hoc Xay dung (IIC) - Truong Dai hoc Xay dung Ha Noi
;;; https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;;
;;; HAI LENH:
;;;   XTD    - chon cac diem, ghi nhan toa do len ban ve va lap bang thong ke
;;;   XTDCSV - chon cac diem, ghi thang ra tep .csv mo bang Excel
;;;
;;; Hoi truoc quy uoc truc: TRAC DIA doi truc (X la bac, tuc Y cua AutoCAD),
;;; CAD thi giu nguyen. Cac ban lisp luu hanh deu doi truc ma khong hoi.
;;; Tep luu bang ma UTF-8. Da chay thu tren AutoCAD 2027 truoc khi phat hanh.
;;; ------------------------------------------------------------------

(vl-load-com)

(defun IIC-GIOI-THIEU ()
  (princ "\nLisp được lập trình bởi RDSIC - Viện Tin học Xây dựng")
  (princ "\nwebsite: https://iic.huce.edu.vn  -  Tel: 0989 427 809")
)

;; Tao chu bang entmake, KHONG dung (command "text" ...): kieu chu co chieu cao
;; co dinh thi dong hoi chieu cao bien mat va moi doi so sau do lech mot nhip.
;; can: 0 trai, 1 giua
(defun IIC:CHU (p cao noi can)
  (entmake (list (cons 0 "TEXT") (cons 10 p) (cons 11 p) (cons 40 cao)
                 (cons 1 noi) (cons 72 can) (cons 73 0)))
)

(defun IIC:NET (a b)
  (entmake (list (cons 0 "LINE") (cons 10 a) (cons 11 b)))
)

(defun IIC:TRON (p r)
  (entmake (list (cons 0 "CIRCLE") (cons 10 p) (cons 40 r)))
)

;; Tra ve (chuoi-X chuoi-Y) theo quy uoc dang chon.
(defun IIC:CAP (p td)
  (if td
    (list (rtos (cadr p) 2 2) (rtos (car p) 2 2))
    (list (rtos (car p) 2 2) (rtos (cadr p) 2 2))
  )
)

(defun IIC:HOI-TRUC ( / k )
  (initget "TracDia Cad")
  (setq k (getkword "\nQuy uoc truc [TracDia/Cad] <TracDia>: "))
  (/= k "Cad")
)

(defun IIC:CHON-DIEM ( / p ds )
  (setq ds nil)
  (while (setq p (getpoint "\nChon diem (Enter de dung): "))
    (setq ds (cons p ds))
  )
  (reverse ds)
)

(defun c:XTD ( / e-cu os-cu ce-cu h td ds n i p cap sx sy
                 p1 p2 p3 rong r pb hang cot1 cot2 cot3 y0 td1 td2 dz-cu )
  (IIC-GIOI-THIEU)
  (setq e-cu *error*
        os-cu (getvar "osmode")
        ce-cu (getvar "cmdecho"))
  ;; Khoi phuc du nguoi dung bam ESC giua chung. Thieu doan nay thi bat diem bi
  ;; tat am tham va nhom hoan tac bi bo ngo - dung loi cua cac ban dang luu hanh.
  (defun *error* (m)
    (setvar "osmode" os-cu) (setvar "cmdecho" ce-cu)
    (if dz-cu (setvar "dimzin" dz-cu))
    (command "_.UNDO" "_End")
    (setq *error* e-cu)
    (if (and m (not (wcmatch (strcase m) "*CANCEL*,*QUIT*")))
      (princ (strcat "\nIIC loi: " m)))
    (princ)
  )
  (command "_.UNDO" "_Begin")
  (setvar "cmdecho" 0)
  ;; DIMZIN = 8 lam rtos cat het so 0 thua, toa do 3200.00 ra thanh 3200.
  ;; Tat trong luc chay roi tra lai, ke ca khi bam ESC.
  (setq dz-cu (getvar "dimzin"))
  (setvar "dimzin" 0)
  (setq h (getvar "TEXTSIZE"))
  (if (<= h 0) (setq h 2.5))
  (setq h (cond ((getreal (strcat "\nChieu cao chu <" (rtos h 2 2) ">: "))) (h)))
  (setq td (IIC:HOI-TRUC))
  (setq ds (IIC:CHON-DIEM))
  (if (null ds)
    (princ "\nKhong chon diem nao.")
    (progn
      (setvar "osmode" 0)
      (setq n (length ds) i 0 rong 0.0 r (* 1.5 h))
      (while (< i n)
        (setq p   (nth i ds)
              cap (IIC:CAP p td)
              sx  (car cap)
              sy  (cadr cap)
              p1  (list (+ (car p) (* 3 h)) (+ (cadr p) (* 3 h)))
              rong (max rong (* (max (strlen sx) (strlen sy)) h 0.72))
        )
        ;; Khe ho chu - net: 0.55 lan chieu cao chu o tren, va o duoi cung vay.
        ;; De 0.35 thi chu dinh sat net, nhin roi (anh Binh bat 20/09/2026).
        (setq p2 (list (+ (car p1) rong (* 0.6 h)) (cadr p1))
              p3 (list (+ (car p2) r (* 0.3 h)) (cadr p1)))
        (IIC:NET p p1)
        (IIC:NET p1 p2)
        (IIC:CHU (list (+ (car p1) (* 0.3 h)) (+ (cadr p1) (* 0.55 h))) h sx 0)
        (IIC:CHU (list (+ (car p1) (* 0.3 h)) (- (cadr p1) (* 1.55 h))) h sy 0)
        (IIC:TRON p3 r)
        (IIC:CHU (list (car p3) (- (cadr p3) (* 0.5 h))) h (strcat "N" (itoa (1+ i))) 1)
        (setq i (1+ i))
      )
      (setq pb (getpoint "\nVi tri dat bang (goc tren ben trai): "))
      (if pb
        (progn
          (setq td1 (if td "Toa do X (bac)" "Toa do X")
                td2 (if td "Toa do Y (dong)" "Toa do Y")
                cot1 (* 5 h)
                cot2 (max (+ rong (* 2 h)) (* (strlen td1) h 0.78))
                cot3 (max (+ rong (* 2 h)) (* (strlen td2) h 0.78))
                hang (* 2.2 h) y0 (cadr pb) i 0)
          (IIC:NET pb (list (+ (car pb) cot1 cot2 cot3) y0))
          (setq y0 (- y0 hang))
          (IIC:CHU (list (+ (car pb) (* 0.5 cot1)) (+ y0 (* 0.6 h))) h "STT" 1)
          (IIC:CHU (list (+ (car pb) cot1 (* 0.5 cot2)) (+ y0 (* 0.7 h))) h td1 1)
          (IIC:CHU (list (+ (car pb) cot1 cot2 (* 0.5 cot3)) (+ y0 (* 0.7 h))) h td2 1)
          (IIC:NET (list (car pb) y0) (list (+ (car pb) cot1 cot2 cot3) y0))
          (while (< i n)
            (setq cap (IIC:CAP (nth i ds) td))
            (IIC:CHU (list (+ (car pb) (* 0.5 cot1)) (- y0 (* 1.4 h))) h
                     (strcat "N" (itoa (1+ i))) 1)
            (IIC:CHU (list (+ (car pb) cot1 (* 0.5 cot2)) (- y0 (* 1.5 h))) h (car cap) 1)
            (IIC:CHU (list (+ (car pb) cot1 cot2 (* 0.5 cot3)) (- y0 (* 1.5 h))) h (cadr cap) 1)
            (setq y0 (- y0 hang) i (1+ i))
            (IIC:NET (list (car pb) y0) (list (+ (car pb) cot1 cot2 cot3) y0))
          )
          (IIC:NET pb (list (car pb) y0))
          (IIC:NET (list (+ (car pb) cot1) (cadr pb)) (list (+ (car pb) cot1) y0))
          (IIC:NET (list (+ (car pb) cot1 cot2) (cadr pb)) (list (+ (car pb) cot1 cot2) y0))
          (IIC:NET (list (+ (car pb) cot1 cot2 cot3) (cadr pb))
                   (list (+ (car pb) cot1 cot2 cot3) y0))
        )
      )
      (princ (strcat "\nDa ghi " (itoa n) " diem."))
    )
  )
  (setvar "osmode" os-cu) (setvar "cmdecho" ce-cu)
  (setvar "dimzin" dz-cu)
  (command "_.UNDO" "_End")
  (setq *error* e-cu)
  (princ)
)

;; XTDCSV - ghi thang ra tep .csv, mo bang Excel duoc ngay.
(defun c:XTDCSV ( / e-cu td ds n i cap f duong dz-cu )
  (IIC-GIOI-THIEU)
  (setq e-cu *error* f nil)
  (setq dz-cu (getvar "dimzin"))
  (setvar "dimzin" 0)
  (defun *error* (m)
    (if f (close f))
    (if dz-cu (setvar "dimzin" dz-cu))
    (setq *error* e-cu)
    (if (and m (not (wcmatch (strcase m) "*CANCEL*,*QUIT*")))
      (princ (strcat "\nIIC loi: " m)))
    (princ)
  )
  (setq td (IIC:HOI-TRUC))
  (setq ds (IIC:CHON-DIEM))
  (if (null ds)
    (princ "\nKhong chon diem nao.")
    (progn
      (setq duong (getfiled "Ghi toa do ra tep" "toado" "csv" 1))
      (if duong
        (progn
          (setq f (open duong "w") n (length ds) i 0)
          (write-line (if td "STT,X (bac),Y (dong)" "STT,X,Y") f)
          (while (< i n)
            (setq cap (IIC:CAP (nth i ds) td))
            (write-line (strcat "N" (itoa (1+ i)) "," (car cap) "," (cadr cap)) f)
            (setq i (1+ i))
          )
          (close f)
          (setq f nil)
          (princ (strcat "\nDa ghi " (itoa n) " diem ra " duong))
        )
      )
    )
  )
  (setvar "dimzin" dz-cu)
  (setq *error* e-cu)
  (princ)
)