;;; ------------------------------------------------------------------
;;; CD-IIC.LSP - cat chan dim trong AutoCAD
;;; Vien Tin hoc Xay dung (IIC) - Truong Dai hoc Xay dung Ha Noi
;;; https://iic.huce.edu.vn  -  Tel: 0989 427 809
;;;
;;; Mot lenh:
;;;   CD  - chon cac dim, roi chon MOT diem; moi chan dim se dung lai
;;;         o ngang diem ay. Con so do KHONG doi.
;;;
;;; 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.
;;; 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")
  (princ "\nTel: 0989 427 809")
)

;; Doc cac ghi de kieu kich thuoc dang co cua mot dim, tra ve danh sach (ma . cap-gia-tri).
(defun IIC-DOC-GHIDE (el / cu i c ds)
  (setq cu (cdr (assoc "ACAD" (cdr (assoc -3 el)))) ds nil i 0)
  (while (< i (length cu))
    (setq c (nth i cu))
    (if (= (car c) 1070)
      (progn (setq ds (cons (cons (cdr c) (nth (1+ i) cu)) ds)) (setq i (+ i 2)))
      (setq i (1+ i))
    )
  )
  (reverse ds)
)

;; Ghi de DIMFXLON (290) va DIMFXL (49) cho RIENG mot dim.
;; GOP vao cac ghi de dang co chu khong thay het: dim thuong da mang san ghi de
;; ti le (DIMSCALE), co chu hay mau, thay het la mat sach nhung thu ay.
(defun IIC-DAT-CHAN (e dai / el ds ra)
  (regapp "ACAD")
  (setq el (entget e (list "ACAD")))
  (setq ds (IIC-DOC-GHIDE el))
  (setq ds (vl-remove-if (function (lambda (x) (member (car x) (list 290 49)))) ds))
  (setq ds (append ds (list (cons 290 (cons 1070 1)) (cons 49 (cons 1040 dai)))))
  (setq ra (list (cons 1000 "DSTYLE") (cons 1002 "{")))
  (foreach x ds (setq ra (append ra (list (cons 1070 (car x)) (cdr x)))))
  (setq ra (append ra (list (cons 1002 "}"))))
  (entmod
    (append (vl-remove-if (function (lambda (x) (= (car x) -3))) el)
      (list (list -3 (cons "ACAD" ra)))))
)

;; CD - chon cac dim roi chon MOT diem; moi chan dim se dung lai o ngang diem ay.
;; Con so do duoc KHONG doi, chi doi cho chan dim ket thuc.
;; Gop ca luot sua thanh MOT buoc hoan tac. Khong co cap StartUndoMark/EndUndoMark
;; thi moi lan entmod la mot buoc rieng: bam U mot cai chi tra lai duoc MOT dim,
;; phan con lai van bi doi. Do ngay 20/09/2026 bang cach so anh truoc/sau/hoan tac.
(defun c:CD ( / ss p i e el p10 ang v dai ti n tl )
  (IIC-GIOI-THIEU)
  (setq tl (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (setq ss (ssget (list (cons 0 "DIMENSION"))))
    (progn
      (setq p (getpoint "\nDiem cat chan dim: ") i 0 n 0)
      (if p
        (progn
          (vla-StartUndoMark tl)
          (while (< i (sslength ss))
            (setq e   (ssname ss i)
                  el  (entget e (list "ACAD"))
                  p10 (cdr (assoc 10 el))
                  ang (+ (cond ((cdr (assoc 50 el))) (0.0)) (/ pi 2.0))
                  v   (mapcar (function -) p p10)
                  dai (abs (+ (* (car v) (cos ang)) (* (cadr v) (sin ang)))))
            ;; DIMFXL bi NHAN voi ti le dim (DIMSCALE), nen phai chia truoc khi ghi.
            ;; Ban ve dung DIMSCALE 100 ma quen chia thi dat 150 hoa ra 15000 don vi,
            ;; dai hon ca chan dim, va lenh nhu khong lam gi ca.
            (setq ti (vla-get-ScaleFactor (vlax-ename->vla-object e)))
            (if (<= ti 0.0) (setq ti 1.0))
            (if (> dai 1e-6) (progn (IIC-DAT-CHAN e (/ dai ti)) (setq n (1+ n))))
            (setq i (1+ i))
          )
          (vla-EndUndoMark tl)
          (princ (strcat "\nDa cat chan cua " (itoa n) " dim."))
        )
      )
    )
  )
  (princ)
)