;;; ==================================================================
;;;  STM-IIC.LSP  -  sua nhieu text va dim theo mot text / dim mau
;;;  Vien Tin hoc Xay dung (IIC) - Truong Dai hoc Xay dung Ha Noi
;;;  https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;; ------------------------------------------------------------------
;;;  Lenh:
;;;    STM    quet chon mot loat TEXT, MTEXT va DIM can sua, Enter,
;;;           roi bam MOT text hoac dim mau. Moi doi tuong da chon nhan
;;;           noi dung cua mau.
;;;             - mau la TEXT/MTEXT: text va mtext nhan dung chu ay, dim
;;;               hien chu ay thay cho so do.
;;;             - mau la DIM: dim nhan dung quy tac ghi de cua mau. Mau ghi
;;;               "L=<>" thi dim nao cung hien "L=" kem SO DO CUA CHINH NO.
;;;               Mau khong ghi de gi thi cac dim tro ve hien so do that.
;;;               Text va mtext nhan chu dang hien tren dim mau.
;;;    STMX   chon cac dim, xoa phan ghi de: dim hien lai so do that.
;;;
;;;  Ten lenh KHONG dat la MT nhu nhieu ban lisp tren mang: MT la lenh
;;;  tat co san cua AutoCAD de mo MTEXT, dat trung thi mat lenh tat ay.
;;;
;;;  Nap tep: go APPLOAD, chon tep nay, bam Load.
;;;  Tep luu bang ma UTF-8. Sua bang Notepad thi nho luu lai dung UTF-8.
;;; ==================================================================

(vl-load-com)

;;; ------------------------------------------------------------------
;;;  Phan chung - moi ham phu mang tien to iic-stm- de khong de len
;;;  ham cung ten cua tep lisp khac dang nap trong cung ban ve.
;;; ------------------------------------------------------------------

(defun iic-stm-bang-ten ()
  (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)
)

(defun iic-stm-tai-lieu () (vla-get-ActiveDocument (vlax-get-acad-object)))

;; Bo ma dinh dang cua MTEXT (\A1; \H2.5; \fArial|b0; \C1; \P ...) de lay
;; chu tron, dung cho TEXT vi TEXT khong hieu cac ma ay.
(defun iic-stm-tron (s / kq i n c k p)
  (setq kq "" i 1 n (strlen s))
  (while (<= i n)
    (setq c (substr s i 1))
    (cond
      ((or (= c "{") (= c "}")) nil)
      ((and (= c "\\") (< i n))
       (setq k (substr s (1+ i) 1))
       (cond
         ((member (strcase k) '("A" "H" "F" "C" "Q" "T" "W" "S"))
          (setq p (vl-string-search ";" s i))
          (setq i (if p (1+ p) n)))
         ((= (strcase k) "P") (setq kq (strcat kq " ") i (1+ i)))
         ((member (strcase k) '("L" "O" "K")) (setq i (1+ i)))
         (t (setq kq (strcat kq k) i (1+ i)))
       ))
      (t (setq kq (strcat kq c)))
    )
    (setq i (1+ i))
  )
  kq
)

;; Chu dang HIEN tren mot kich thuoc: lay MTEXT nam trong khoi an danh
;; cua no. Day moi la chu nguoi xem thay, da tinh ca ghi de lan so do.
(defun iic-stm-chu-dim (d / e ed kq)
  (setq e (entnext (tblobjname "BLOCK" (cdr (assoc 2 d)))) kq "")
  (while (and e (= kq ""))
    (setq ed (entget e))
    (if (= (cdr (assoc 0 ed)) "MTEXT")
      (setq kq (vla-get-TextString (vlax-ename->vla-object e)))
    )
    (setq e (entnext e))
  )
  (iic-stm-tron kq)
)

;; Doc mau. Tra ve (chu-tron chu-mtext ghi-de-dim).
(defun iic-stm-doc-mau (en / d loai o gd)
  (setq d (entget en) loai (cdr (assoc 0 d)) o (vlax-ename->vla-object en))
  (cond
    ((= loai "TEXT")
     (list (cdr (assoc 1 d)) (cdr (assoc 1 d)) (cdr (assoc 1 d))))
    ((= loai "MTEXT")
     (list (iic-stm-tron (vla-get-TextString o)) (vla-get-TextString o)
           (iic-stm-tron (vla-get-TextString o))))
    ((= loai "DIMENSION")
     (setq gd (vla-get-TextOverride o))
     (list (iic-stm-chu-dim d) (iic-stm-chu-dim d) gd))
  )
)

;; Ap mau vao mot doi tuong. Tra ve T neu da sua.
(defun iic-stm-ap (en mau / d loai o)
  (setq d (entget en) loai (cdr (assoc 0 d)) o (vlax-ename->vla-object en))
  (cond
    ((= loai "TEXT")
     (entmod (subst (cons 1 (car mau)) (assoc 1 d) d)) (entupd en) T)
    ((= loai "MTEXT")
     (vla-put-TextString o (cadr mau)) T)
    ((= loai "DIMENSION")
     (vla-put-TextOverride o (caddr mau)) (vla-Update o) T)
    (t nil)
  )
)

;;; ------------------------------------------------------------------
;;;  Lenh STM
;;; ------------------------------------------------------------------

(defun c:STM (/ *error* ss e nguon mau xong i en n)
  (defun *error* (m)
    (vla-EndUndoMark (iic-stm-tai-lieu))
    (if (not (wcmatch (strcase m) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nLỗi: " m))
    )
    (princ)
  )
  (iic-stm-bang-ten)
  (princ "\nChọn các text, mtext và dim cần sửa:")
  (setq ss (ssget '((0 . "TEXT,MTEXT,DIMENSION"))))
  (if ss
    (progn
      ;; bam mau: bam truot thi bam lai, bam nham loai thi bao roi bam lai,
      ;; Enter de thoi.
      (while (not xong)
        (setvar "ERRNO" 0)
        (setq e (entsel "\nBấm text hoặc dim mẫu: "))
        (cond
          ((and (null e) (= (getvar "ERRNO") 7)) (princ "\nBấm trượt, bấm lại."))
          ((null e) (setq xong T))
          ((member (cdr (assoc 0 (entget (car e)))) '("TEXT" "MTEXT" "DIMENSION"))
           (setq nguon (car e) mau (iic-stm-doc-mau nguon) xong T))
          (t (princ "\nĐối tượng ấy không phải text, mtext hay dim. Bấm lại."))
        )
      )
      (if mau
        (progn
          (vla-StartUndoMark (iic-stm-tai-lieu))
          (setq i 0 n 0)
          (while (< i (sslength ss))
            (setq en (ssname ss i))
            (if (and (not (equal en nguon)) (iic-stm-ap en mau))
              (setq n (1+ n))
            )
            (setq i (1+ i))
          )
          (vla-EndUndoMark (iic-stm-tai-lieu))
          (princ (strcat "\nĐã sửa " (itoa n) " đối tượng theo mẫu \"" (car mau) "\"."))
        )
      )
    )
    (princ "\nKhông chọn được text, mtext hay dim nào.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  Lenh STMX - xoa ghi de, dim hien lai so do that
;;; ------------------------------------------------------------------

(defun c:STMX (/ *error* ss i o n)
  (defun *error* (m)
    (vla-EndUndoMark (iic-stm-tai-lieu))
    (if (not (wcmatch (strcase m) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nLỗi: " m))
    )
    (princ)
  )
  (iic-stm-bang-ten)
  (princ "\nChọn các dim cần trả về số đo thật:")
  (setq ss (ssget '((0 . "DIMENSION"))))
  (if ss
    (progn
      (vla-StartUndoMark (iic-stm-tai-lieu))
      (setq i 0 n 0)
      (while (< i (sslength ss))
        (setq o (vlax-ename->vla-object (ssname ss i)))
        (if (/= (vla-get-TextOverride o) "")
          (progn (vla-put-TextOverride o "") (vla-Update o) (setq n (1+ n)))
        )
        (setq i (1+ i))
      )
      (vla-EndUndoMark (iic-stm-tai-lieu))
      (princ (strcat "\nĐã trả " (itoa n) " dim về số đo thật."))
    )
    (princ "\nKhông chọn được dim nào.")
  )
  (princ)
)

(princ "\nĐã nạp STM-IIC: gõ STM để sửa theo mẫu, STMX để trả dim về số đo thật.")
(iic-stm-bang-ten)