;;; ============================================================
;;;  STT-IIC.lsp  -  Danh so thu tu trong AutoCAD
;;;  Vien Tin hoc Xay dung - Truong Dai hoc Xay dung Ha Noi
;;;  https://iic.huce.edu.vn
;;;
;;;  STT   : danh so thuoc tinh cua block, sap xep theo HANG roi tu trai sang phai
;;;  STTT  : danh so cac doi tuong TEXT / MTEXT co san, theo thu tu bam chon
;;;  STTD  : dat chuoi chu so moi bang cach bam diem lien tiep
;;;
;;;  Diem khac cac lisp dang luu hanh: phep sap xep co DUNG SAI HANG, nen hai
;;;  block lech nhau vai phan nghin don vi van duoc coi la cung mot hang va
;;;  danh tu trai sang phai. Moi lenh deu goi trong mot nhom hoan tac, nen mot
;;;  lan go U la tra lai nguyen trang.
;;; ============================================================

(vl-load-com)

;;; --- chon kieu chu viet duoc tieng Viet -----------------------------
;;  Do tren AutoCAD 2027 ngay 20/09/2026: trong 41 phong .shx Unicode di kem
;;  AutoCAD, KHONG phong nao co du glyph tieng Viet, nen chu co dau ve ra dau
;;  hoi. Vi the truoc khi viet chu, lenh tu thu kieu chu hien hanh: viet duoc
;;  tieng Viet thi giu nguyen phong cua ban ve, khong thi tao kieu IIC-VN
;;  bang phong TrueType co san trong moi may Windows.

(defun IIC:rong-kieu (s cao kieu / e o mn mx w)
  (if (= s "")
    0.0
    (progn
      (entmake (list (cons 0 "TEXT") (cons 10 (list 0.0 0.0 0.0)) (cons 40 cao)
                     (cons 1 s) (cons 7 kieu)))
      (setq e (entlast) o (vlax-ename->vla-object e))
      (vla-GetBoundingBox o 'mn 'mx)
      (setq mn (vlax-safearray->list mn) mx (vlax-safearray->list mx)
            w (- (car mx) (car mn)))
      (entdel e)
      w)))

;; Phep do co doi chung: ky tu "ờ" ma rong dung bang dau "?" tuc la phong
;; da thay no bang dau hoi, nghia la phong khong co glyph tieng Viet.
(defun IIC:viet-duoc (kieu / a b)
  (if (tblsearch "style" kieu)
    (progn
      (setq a (IIC:rong-kieu "ờ" 100.0 kieu)
            b (IIC:rong-kieu "?" 100.0 kieu))
      (> (abs (- a b)) 0.01))
    nil))

(defun IIC:tao-kieu (ten phong rong)
  (entmake (list (cons 0 "STYLE") (cons 100 "AcDbSymbolTableRecord")
                 (cons 100 "AcDbTextStyleTableRecord") (cons 2 ten) (cons 70 0)
                 (cons 40 0.0) (cons 41 rong) (cons 50 0.0) (cons 71 0)
                 (cons 42 2.5) (cons 3 phong) (cons 4 ""))))

(defun IIC:kieu-viet ( / ht)
  (setq ht (getvar "textstyle"))
  (cond
    ((IIC:viet-duoc ht) ht)
    ((IIC:viet-duoc "IIC-VN")
     (princ "\n  Kiểu chữ hiện hành không có dấu tiếng Việt, dùng kiểu IIC-VN.")
     "IIC-VN")
    (t
     (IIC:tao-kieu "IIC-VN" "arial.ttf" 0.85)
     (if (IIC:viet-duoc "IIC-VN")
       (progn
         (princ (strcat "\n  Kiểu chữ \"" ht "\" không có dấu tiếng Việt."))
         (princ "\n  Đã tạo kiểu IIC-VN (phông Arial) để chữ không ra dấu hỏi.")
         "IIC-VN")
       ht))))

(defun IIC:banner ()
  (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")
  (princ "\nTel: 0989 427 809")
  (princ))


;;; --- tien ich chung --------------------------------------------------

;; chuoi so co dem so 0 cho du be rong
(defun IIC:so-dem (n rong / s)
  (setq s (itoa n))
  (while (< (strlen s) rong) (setq s (strcat "0" s)))
  s)

;; hoi mot so nguyen, co gia tri mac dinh
(defun IIC:hoi-so (nhac mac / v)
  (initget 4)
  (setq v (getint (strcat nhac " <" (itoa mac) ">: ")))
  (if v v mac))

;; hoi mot chuoi, co gia tri mac dinh
(defun IIC:hoi-chu (nhac mac / v)
  (setq v (getstring t (strcat nhac " <" mac ">: ")))
  (if (= v "") mac v))

;; mo / dong nhom hoan tac
(defun IIC:mo-undo () (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-Acad-Object))))
(defun IIC:dong-undo () (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-Acad-Object))))

;; hoi bo thong so chung: tien to, so dau, buoc, be rong
(defun IIC:hoi-thong-so (/ )
  (or *iic-tien-to* (setq *iic-tien-to* ""))
  (or *iic-so-dau*  (setq *iic-so-dau*  1))
  (or *iic-buoc*    (setq *iic-buoc*    1))
  (or *iic-rong*    (setq *iic-rong*    2))
  (setq *iic-tien-to* (IIC:hoi-chu "\nTiền tố (Enter để giữ, gõ dấu chấm để xóa)" *iic-tien-to*))
  (if (= *iic-tien-to* ".") (setq *iic-tien-to* ""))
  (setq
        *iic-so-dau*  (IIC:hoi-so  "\nSố bắt đầu" *iic-so-dau*)
        *iic-buoc*    (IIC:hoi-so  "\nBước nhảy" *iic-buoc*)
        *iic-rong*    (IIC:hoi-so  "\nBề rộng chữ số (2 = 01, 3 = 001)" *iic-rong*))
  t)

;; chuoi hien thi cho so thu n
(defun IIC:chuoi (n) (strcat *iic-tien-to* (IIC:so-dem n *iic-rong*)))

;; chuoi nay co ky tu ngoai bang ASCII khong?
(defun IIC:co-dau (s / co)
  (setq co nil)
  (foreach c (vl-string->list s) (if (> c 127) (setq co t)))
  co)

;;; --- sap xep theo hang, co dung sai ----------------------------------
;;  ds : danh sach (doi-tuong diem)
;;  dsai : hai diem lech nhau khong qua dsai theo truc Y thi coi la cung hang
(defun IIC:xep-hang (ds dsai / con hang y0 ra)
  (setq con (vl-sort ds '(lambda (a b) (> (cadr (cadr a)) (cadr (cadr b))))))
  (while con
    (setq y0 (cadr (cadr (car con))) hang nil)
    (while (and con (<= (abs (- (cadr (cadr (car con))) y0)) dsai))
      (setq hang (cons (car con) hang) con (cdr con)))
    (setq hang (vl-sort hang '(lambda (a b) (< (car (cadr a)) (car (cadr b))))))
    (setq ra (append ra hang)))
  ra)

;;; --- STT : danh so thuoc tinh cua block -------------------------------
(defun IIC:stt-block (/ ent dl ten tag ss i e ds diem n dem dsai)
  (IIC:banner)
  (setq ent nil)
  (while (not ent)
    (setq ent (car (nentsel "\nChọn MỘT thuộc tính mẫu trong block cần đánh số: ")))
    (if (and ent (/= (cdr (assoc 0 (entget ent))) "ATTRIB"))
      (progn (princ "\nĐó không phải thuộc tính. Chọn lại.") (setq ent nil))))
  (setq dl  (entget ent)
        tag (cdr (assoc 2 dl))
        ten (cdr (assoc 2 (entget (cdr (assoc 330 dl))))))
  (princ (strcat "\nBlock: " ten "  |  Thuộc tính: " tag))
  (IIC:hoi-thong-so)
  (or (numberp *iic-dung-sai*) (setq *iic-dung-sai* 1.0))
  (setq dsai (atof (IIC:hoi-chu "\nDung sai hàng (hai block lệch Y nhỏ hơn số này là cùng hàng)" (rtos *iic-dung-sai* 2 3))))
  (if (<= dsai 0.0) (setq dsai *iic-dung-sai*))
  (setq *iic-dung-sai* dsai)
  (princ "\nChọn các block cần đánh số: ")
  (setq ss (ssget (list (cons 0 "INSERT") (cons 66 1) (cons 2 ten))))
  (if (null ss)
    (princ "\nKhông chọn được block nào.")
    (progn
      (IIC:mo-undo)
      (setq i 0 ds nil)
      (while (< i (sslength ss))
        (setq e (vlax-ename->vla-object (ssname ss i))
              diem (vlax-safearray->list (variant-value (vla-get-InsertionPoint e)))
              ds (cons (list e diem) ds)
              i (1+ i)))
      (setq ds (IIC:xep-hang ds dsai) n *iic-so-dau* dem 0)
      (foreach c ds
        (foreach att (vlax-invoke (car c) 'GetAttributes)
          (if (= (strcase (vla-get-TagString att)) (strcase tag))
            (progn (vla-put-TextString att (IIC:chuoi n)) (setq dem (1+ dem)))))
        (setq n (+ n *iic-buoc*)))
      (setq *iic-so-dau* n)
      (IIC:dong-undo)
      (princ (strcat "\nĐã đánh số " (itoa dem) " thuộc tính trên " (itoa (sslength ss)) " block."))))
  (princ))

;;; --- STTT : danh so cac doi tuong chu da co ---------------------------
(defun IIC:stt-chu (/ e n dem dl)
  (IIC:banner)
  (IIC:hoi-thong-so)
  (princ "\nBấm lần lượt vào từng dòng chữ theo đúng thứ tự muốn đọc.")
  (setq n *iic-so-dau* dem 0)
  (IIC:mo-undo)
  (while (setq e (car (entsel "\nChọn dòng chữ (Enter để dừng): ")))
    (setq dl (entget e))
    (if (member (cdr (assoc 0 dl)) '("TEXT" "MTEXT"))
      (progn
        (entmod (subst (cons 1 (IIC:chuoi n)) (assoc 1 dl) dl))
        (entupd e)
        (setq n (+ n *iic-buoc*) dem (1+ dem))
        (princ (strcat "  -> " (IIC:chuoi (- n *iic-buoc*)))))
      (princ "\n  (bỏ qua: không phải TEXT hay MTEXT)")))
  (setq *iic-so-dau* n)
  (IIC:dong-undo)
  (princ (strcat "\nĐã đánh số " (itoa dem) " dòng chữ."))
  (princ))

;;; --- STTD : dat chuoi chu so moi --------------------------------------
(defun IIC:stt-dat (/ p n dem cao lop kieu)
  (IIC:banner)
  (IIC:hoi-thong-so)
  (or (numberp *iic-cao*) (setq *iic-cao* (getvar "textsize")))
  (if (or (null *iic-cao*) (<= *iic-cao* 0.0)) (setq *iic-cao* 2.5))
  (setq *iic-cao* (atof (IIC:hoi-chu "\nChiều cao chữ" (rtos *iic-cao* 2 2))))
  (if (<= *iic-cao* 0.0) (setq *iic-cao* 2.5))
  (setq lop (getvar "clayer")
        kieu (if (IIC:co-dau *iic-tien-to*) (IIC:kieu-viet) (getvar "textstyle")))
  (princ (strcat "\nChữ sẽ nằm trên lớp hiện hành: " lop))
  (setq n *iic-so-dau* dem 0)
  (IIC:mo-undo)
  (while (setq p (getpoint "\nBấm điểm đặt số (Enter để dừng): "))
    (entmake (list (cons 0 "TEXT") (cons 8 lop) (cons 10 p)
                   (cons 40 *iic-cao*) (cons 1 (IIC:chuoi n))
                   (cons 72 1) (cons 73 2) (cons 11 p) (cons 7 kieu)))
    (setq n (+ n *iic-buoc*) dem (1+ dem)))
  (setq *iic-so-dau* n)
  (IIC:dong-undo)
  (princ (strcat "\nĐã đặt " (itoa dem) " số."))
  (princ))

;;; Hai ten goi cho moi viec. Nhieu lisp dang luu hanh cung dat ten lenh STT,
;;; nap sau se de len nap truoc; ba ten co duoi IIC goi thang vao than ham nen
;;; khong bao gio bi chiem.
(defun c:STT     () (IIC:stt-block))
(defun c:STTIIC  () (IIC:stt-block))
(defun c:STTT    () (IIC:stt-chu))
(defun c:STTTIIC () (IIC:stt-chu))
(defun c:STTD    () (IIC:stt-dat))
(defun c:STTDIIC () (IIC:stt-dat))

(princ)
(IIC:banner)
(princ "\nĐã nạp STT-IIC. Lệnh: STT (block có thuộc tính), STTT (chữ đã có), STTD (đặt số mới).\nNếu tên STT bị lisp khác chiếm, gọi bằng STTIIC / STTTIIC / STTDIIC.\n")
(princ)