;;; ==================================================================
;;;  BLK-IIC.LSP  -  lam viec voi BLOCK hang loat
;;;  Vien Tin hoc Xay dung (IIC) - Truong Dai hoc Xay dung Ha Noi
;;;  https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;; ------------------------------------------------------------------
;;;  Bon lenh:
;;;    BKD     dem block theo ten, in bang thong ke ra dong lenh
;;;    BKM     doi mau MOI ban chen cua mot block
;;;    BKT     doi ten mot block, moi ban chen tu theo
;;;    BKP     pha het cac ban chen cua MOT block (cac block khac giu nguyen)
;;;
;;;  Vi sao can tep nay: AutoCAD co lenh BCOUNT dem block nhung no nam
;;;  trong Express Tools, va khong phai may nao cung cai. Con viec doi
;;;  mau hay pha rieng mot loai block thi khong co lenh nao lam duoc:
;;;  lenh QSELECT chon duoc theo ten block nhung phai qua hop thoai, va
;;;  moi lan chi mot dieu kien.
;;;
;;;  BON DIEU CAN BIET TRUOC KHI CHAY:
;;;    1. BKD dem BAN CHEN, khong dem dinh nghia. Mot block chen 40 lan
;;;       thi dem ra 40. Ban chen nam trong block khac (block long nhau)
;;;       KHONG duoc dem - chi dem lop ngoai cung.
;;;    2. BKM doi mau cua BAN CHEN chu khong doi mau cac net ben trong.
;;;       Net nao ben trong dat mau CUNG (khong phai ByBlock) thi giu
;;;       nguyen mau cu, doi bao nhieu lan cung the. Day la ly do quen
;;;       thuoc cua "doi mau roi ma no khong doi".
;;;    3. BKT doi ten dinh nghia block. Ban ve nao dang xref toi ban ve
;;;       nay, hay bang thong ke nao dang tra theo ten cu, deu hong.
;;;    4. BKP pha ban chen; block chen voi ti le X khac Y VAN pha duoc,
;;;       nhung duong tron ben trong se thanh ELIP. Khong tranh duoc.
;;;  Moi lenh deu IN ra so ban chen da dung toi, de doi chieu.
;;;
;;;  Ten lenh da do truoc khi dat: tep bi danh acad.pgp cua ban 2027
;;;  khong co BKD, BKM, BKT lan BKP.
;;;
;;;  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)

;;; canh trai / canh phai trong o rong n
(defun iic-dem (s n) (while (< (strlen s) n) (setq s (strcat s " "))) s)
(defun iic-phai (s n) (while (< (strlen s) n) (setq s (strcat " " s))) s)

;;; ------------------------------------------------------------------
;;;  Ten that cua mot ban chen. Block dong thi ten hien la "*U123",
;;;  phai hoi EffectiveName moi ra ten goc.
;;; ------------------------------------------------------------------
(defun iic-ten (e / o tn)
  ;; KHONG dat bien cuc bo ten "t": trong AutoLISP T la hang so dung,
  ;; gan no lam bien thi may bao "; error: incorrect object to bind: T".
  (setq o (vlax-ename->vla-object e))
  (setq tn (vl-catch-all-apply 'vlax-get (list o 'EffectiveName)))
  (if (or (vl-catch-all-error-p tn) (null tn))
    (cdr (assoc 2 (entget e)))
    tn
  )
)

;;; ------------------------------------------------------------------
;;;  BKD - dem block theo ten
;;; ------------------------------------------------------------------
(defun c:BKD (/ ss i e ten bang o tong)
  (princ "\nChon vung can dem (Enter de dem ca ban ve): ")
  (setq ss (ssget '((0 . "INSERT"))))
  (if (null ss) (setq ss (ssget "_X" '((0 . "INSERT")))))
  (if ss
    (progn
      (setq bang nil i 0)
      (while (< i (sslength ss))
        (setq e   (ssname ss i)
              ten (iic-ten e)
              o   (assoc ten bang))
        (if o
          (setq bang (subst (cons ten (1+ (cdr o))) o bang))
          (setq bang (cons (cons ten 1) bang))
        )
        (setq i (1+ i))
      )
      (setq bang (vl-sort bang (function (lambda (a b) (> (cdr a) (cdr b))))))
      (setq tong 0)
      (princ "\n")
      (princ "\n  Ten block                        So ban chen")
      (princ "\n  ---------------------------------------------")
      (foreach o bang
        (setq tong (+ tong (cdr o)))
        (princ (strcat "\n  " (iic-dem (car o) 32) (iic-phai (itoa (cdr o)) 11)))
      )
      (princ "\n  ---------------------------------------------")
      (princ (strcat "\n  Tong so ban chen" (iic-phai (itoa tong) 29)))
      (princ (strcat "\n  So ten block khac nhau" (iic-phai (itoa (length bang)) 23)))
      (princ "\n")
    )
    (princ "\nKhong co ban chen block nao.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  BKM - doi mau moi ban chen cua mot block
;;; ------------------------------------------------------------------
(defun c:BKM (/ ten mau ss i e n)
  (setq ten (getstring T "\nTen block can doi mau: "))
  (if (= ten "") (progn (princ "\nChua khai ten.") (exit)))
  (setq mau (getint "\nSo mau (1 do, 2 vang, 3 luc, 4 lam nhat, 5 lam, 7 trang): "))
  (if (null mau) (progn (princ "\nChua khai mau.") (exit)))
  (setq ss (ssget "_X" '((0 . "INSERT"))) i 0 n 0)
  (if ss
    (progn
      (while (< i (sslength ss))
        (setq e (ssname ss i))
        (if (= (strcase (iic-ten e)) (strcase ten))
          (progn
            (entmod (append (vl-remove-if (function (lambda (x) (= (car x) 62)))
                                          (entget e))
                            (list (cons 62 mau))))
            (setq n (1+ n))
          )
        )
        (setq i (1+ i))
      )
      (princ (strcat "\nDa doi mau " (itoa n) " ban chen cua block \"" ten "\"."))
      (if (= n 0)
        (princ "\nKhong tim thay ban chen nao mang ten do. Go BKD de xem danh sach ten.")
        (princ "\nLuu y: net nao ben trong block dat mau cung thi khong doi theo.")
      )
    )
    (princ "\nBan ve khong co block nao.")
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  BKT - doi ten block
;;; ------------------------------------------------------------------
(defun c:BKT (/ cu moi bl kq)
  (setq cu (getstring T "\nTen block hien tai: "))
  (setq moi (getstring T "\nTen moi: "))
  (if (or (= cu "") (= moi ""))
    (progn (princ "\nThieu ten.") (exit))
  )
  (setq bl (tblobjname "BLOCK" cu))
  (if (null bl)
    (princ (strcat "\nKhong co block nao ten \"" cu "\". Go BKD de xem danh sach."))
    (if (tblobjname "BLOCK" moi)
      (princ (strcat "\nDa co block ten \"" moi "\" roi. Chon ten khac."))
      (progn
        (setq kq (vl-catch-all-apply
                   'vla-put-Name
                   (list (vla-item (vla-get-Blocks
                                     (vla-get-ActiveDocument
                                       (vlax-get-acad-object))) cu) moi)))
        (if (vl-catch-all-error-p kq)
          (princ (strcat "\nKhong doi duoc: " (vl-catch-all-error-message kq)))
          (progn
            (princ (strcat "\nDa doi \"" cu "\" thanh \"" moi "\"."))
            (princ "\nLuu y: bang thong ke nao tra theo ten cu se khong tim thay nua.")
          )
        )
      )
    )
  )
  (princ)
)

;;; ------------------------------------------------------------------
;;;  BKP - pha het ban chen cua MOT block
;;; ------------------------------------------------------------------
(defun c:BKP (/ ten ss i e ds ds2 n x)
  (setq ten (getstring T "\nTen block can pha: "))
  (if (= ten "") (progn (princ "\nChua khai ten.") (exit)))
  (setq ss (ssget "_X" '((0 . "INSERT"))) i 0 ds (ssadd))
  (if ss
    (progn
      (while (< i (sslength ss))
        (setq e (ssname ss i))
        (if (= (strcase (iic-ten e)) (strcase ten))
          (setq ds (ssadd e ds))
        )
        (setq i (1+ i))
      )
      (setq n (sslength ds))
      (if (= n 0)
        (princ (strcat "\nKhong co ban chen nao ten \"" ten "\"."))
        (progn
          ;; Pha TUNG ban chen mot. Truyen ca tap chon vao
          ;; (command "_.EXPLODE" ds) thi may chi pha DUNG MOT cai roi thoi
          ;; - da do tren ban 2027: chon 5 ban chen ma chi sinh 1 doi tuong
          ;; moi. Phai nhat het ename ra danh sach TRUOC khi pha, vi pha
          ;; xong la ename cu bien mat khoi ban ve.
          (setq i 0 ds2 nil)
          (while (< i n)
            (setq ds2 (cons (ssname ds i) ds2) i (1+ i))
          )
          (foreach x ds2 (command "_.EXPLODE" x))
          (princ (strcat "\nDa pha " (itoa n) " ban chen cua block \"" ten "\"."))
          (princ "\nLuu y: duong tron trong block chen lech ti le se thanh elip.")
        )
      )
    )
    (princ "\nBan ve khong co block nao.")
  )
  (princ)
)

(princ "\nBLK-IIC da nap. Lenh: BKD (dem), BKM (doi mau), BKT (doi ten), BKP (pha).")
(princ)