Chức năng CIS

Chèn số đo góc tại các điểm giao nhau.

Lisp miễn phí được chia sẻ bởi Tác giả: Nguyễn Văn Thương - Phone: 03.3626.3629

1 Thêm class CIS.lsp

Lưu mã sau dưới dạng tệp tin CIS.lsp

Code:

(vl-load-com)

(setq *txt_h* 250)  ; default text height

;;-------------------------------------------
;; Hàm tạo TEXT tại điểm, căn giữa
;;-------------------------------------------
(defun make-text-middle (pos txt h / len)
  (setq len (* h (strlen txt) 0.6))
  (entmakex
    (list
      '(0 . "TEXT")
      (cons 10 (list (- (car pos) (/ len 2.0))
                     (- (cadr pos) (/ h 2.0))))
      (cons 40 h)
      (cons 1 txt)
      '(50 . 0)
      '(7 . "STANDARD")
    )
  )
)

;;-------------------------------------------
;; Lấy danh sách điểm LWPOLYLINE
;;-------------------------------------------
(defun get-pline-pts (ename / lst)
  (setq lst '())
  (foreach d (entget ename)
    (if (= (car d) 10)
      (setq lst (append lst (list (cdr d))))
    )
  )
  lst
)

(defun pline-to-lines (pts closed / lines n i)
  (setq lines '())
  (setq n (length pts))
  (setq i 0)
  (while (< i (- n 1))
    (setq lines (cons (list (nth i pts) (nth (1+ i) pts)) lines))
    (setq i (1+ i))
  )
  (if closed
    (setq lines (cons (list (nth (- n 1) pts) (nth 0 pts)) lines))
  )
  lines
)

;;-------------------------------------------
;; Kiểm tra điểm trên đoạn thẳng
;;-------------------------------------------
(defun pt-on-line? (p a b / cross dot len2)
  (setq cross (- (* (- (car b) (car a)) (- (cadr p) (cadr a)))
                 (* (- (cadr b) (cadr a)) (- (car p) (car a)))))
  (setq dot (+ (* (- (car p) (car a)) (- (car b) (car a)))
               (* (- (cadr p) (cadr a)) (- (cadr b) (cadr a)))))
  (setq len2 (+ (expt (- (car b) (car a)) 2) (expt (- (cadr b) (cadr a)) 2)))
  (and (< (abs cross) 1e-6) (<= 0 dot) (<= dot len2))
)

;;-------------------------------------------
;; Đếm số vector tại điểm
;;-------------------------------------------
(defun count-vectors (pt lines / count a b)
  (setq count 0)
  (foreach line lines
    (setq a (nth 0 line))
    (setq b (nth 1 line))
    (cond
      ((equal pt a 1e-6) (setq count (+ count 1)))
      ((equal pt b 1e-6) (setq count (+ count 1)))
      ((and (not (equal pt a 1e-6)) (not (equal pt b 1e-6)) (pt-on-line? pt a b))
       (setq count (+ count 2)))
    )
  )
  count
)

;;-------------------------------------------
;; Lấy vector tại điểm
;;-------------------------------------------
(defun vectors-at-pt (pt lines / vecs a b)
  (setq vecs '())
  (foreach line lines
    (setq a (nth 0 line))
    (setq b (nth 1 line))
    (cond
      ((equal pt a 1e-6) (setq vecs (cons (list (- (car b) (car a)) (- (cadr b) (cadr a))) vecs)))
      ((equal pt b 1e-6) (setq vecs (cons (list (- (car a) (car b)) (- (cadr a) (cadr b))) vecs)))
      ((and (not (equal pt a 1e-6)) (not (equal pt b 1e-6)) (pt-on-line? pt a b))
       (setq vecs (cons (list (- (car b) (car a)) (- (cadr b) (cadr a))) vecs))
       (setq vecs (cons (list (- (car a) (car b)) (- (cadr a) (cadr b))) vecs))
      )
    )
  )
  vecs
)

;;-------------------------------------------
;; Hàm tính góc vector
;;-------------------------------------------
(defun vec-angle (v / ang)
  (setq ang (atan (cadr v) (car v)))
  (if (< ang 0) (+ ang (* 2 pi)) ang)
)

(defun vec-scale (v f / len)
  (setq len (sqrt (+ (expt (car v) 2) (expt (cadr v) 2))))
  (if (> len 1e-6)
    (list (* (car v) (/ f len)) (* (cadr v) (/ f len)))
    '(0 0)
  )
)

(defun my-mod (a b)
  (- a (* b (fix (/ a b))))
)

;;-------------------------------------------
;; Lệnh chính: COUNT-VECTOR-ANGLE
;;-------------------------------------------
(defun c:CIS ( / ss ent ed typ pts all-lines vertex-count pt num vecs n i v1 v2 v1-n v2-n bisector mid ang ang-small v1-small v2-small)
  ;; Chiều cao chữ
  (setq tmp (getreal (strcat "\nText height <" (rtos *txt_h* 2 0) ">: ")))
  (if tmp (setq *txt_h* tmp))

  ;; Chọn LINE/LWPOLYLINE
  (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
  (if (not ss) (progn (prompt "\nNothing selected.") (exit)))

  ;; Thu thập tất cả line
  (setq all-lines '())
  (repeat (sslength ss)
    (setq ent (ssname ss 0))
    (setq ss (ssdel ent ss))
    (setq ed (entget ent))
    (setq typ (cdr (assoc 0 ed)))
    (cond
      ((= typ "LINE")
       (setq a (cdr (assoc 10 ed)))
       (setq b (cdr (assoc 11 ed)))
       (if (and a b) (setq all-lines (cons (list a b) all-lines)))
      )
      ((= typ "LWPOLYLINE")
       (setq pts (get-pline-pts ent))
       (setq closed (= (logand (cdr (assoc 70 ed)) 1) 1))
       (if pts (setq all-lines (append all-lines (pline-to-lines pts closed))))
      )
    )
  )

  ;; Tạo danh sách đỉnh và đếm vector
  (setq vertex-count '())
  (foreach line all-lines
    (foreach pt line
      (if (not (assoc pt vertex-count))
        (setq vertex-count (cons (cons pt 0) vertex-count))
      )
    )
  )
  (setq vertex-count
    (mapcar
      (function (lambda (v) (cons (car v) (count-vectors (car v) all-lines))))
      vertex-count
    )
  )

  ;; Chèn số vector và góc
  (foreach v vertex-count
    (setq pt (car v))
    (setq num (cdr v))
    
    ;; Số vector
    (make-text-middle pt (itoa num) *txt_h*)

    ;; Lấy vector tại điểm, sắp xếp theo góc
    (setq vecs (vectors-at-pt pt all-lines))
    (setq vecs (vl-sort vecs (function (lambda (v1 v2) (< (vec-angle v1) (vec-angle v2))))))

    (setq n (length vecs))
    (setq i 0)
    (while (< i n)
      (setq v1 (nth i vecs))
      (setq v2 (nth (my-mod (+ i 1) n) vecs))

      (setq v1-n (vec-scale v1 1.0))
      (setq v2-n (vec-scale v2 1.0))

      ;; Tính góc giữa v1 và v2
      (setq ang (- (vec-angle v2) (vec-angle v1)))
      (if (< ang 0) (setq ang (+ ang (* 2 pi))))
      (setq ang (* 180.0 (/ ang pi)))

      ;; Xử lý đỉnh 2 vector
      (if (= n 2)
        (progn
          ;; chuẩn hóa góc nhỏ và lớn
          (setq ang-small ang)
          (setq v1-small v1-n)
          (setq v2-small v2-n)
          (if (> ang 180.0)
            (progn
              (setq ang-small (- 360.0 ang))
              (setq v1-small v2-n)
              (setq v2-small v1-n)
            )
          )
          ;; Góc nhỏ
          (setq bisector (vec-scale (mapcar '+ v1-small v2-small) (* 2.0 *txt_h*)))
          (make-text-middle (mapcar '+ pt bisector) (rtos ang-small 2 1) *txt_h*)
          ;; Góc lớn → đối xứng
          (setq bisector-large (mapcar '- bisector))
          (make-text-middle (mapcar '+ pt bisector-large) (rtos (- 360.0 ang-small) 2 1) *txt_h*)
          (setq i n) ; thoát while
        )
        ;; Đỉnh ≥3 vector
        (progn
          ;; Góc 180° → dùng vector vuông góc
          (if (equal ang 180.0 1e-6)
            (setq bisector (vec-scale (list (- (cadr v1-n)) (car v1-n)) (* 2.0 *txt_h*)))
            ;; Góc khác → phân giác
            (setq bisector (vec-scale (mapcar '+ v1-n v2-n) (* 2.0 *txt_h*)))
          )
          ;; Nếu góc >180° → chiếu đối xứng qua đỉnh
          (if (> ang 180.0)
            (setq bisector (mapcar '- bisector))
          )
          (setq mid (mapcar '+ pt bisector))
          (make-text-middle mid (rtos ang 2 1) *txt_h*)
          (setq i (1+ i))
        )
      )
    )
  )

  (prompt "\nĐã chèn số vector và tất cả góc tại đỉnh, thoải mái dùng đi nhé.")
  (princ "\nTác giả: Nguyễn Văn Thương - Phone: 03.3626.3629")
  (princ)
)

Chức năng CISP

Chèn các ký hiệu thiết bị tại vị trí giao nhau

Lisp miễn phí được chia sẻ bởi Tác giả: Nguyễn Văn Thương - Phone: 03.3626.3629

2 Thêm class CISP.lsp

Lưu mã sau dưới dạng tệp tin CISP.lsp

Code:

(vl-load-com)

(setq *txt_h* 250)  ; default text height

;;-------------------------------------------
;; Hàm tạo TEXT tại điểm, căn giữa
;; Trả về ename của TEXT vừa tạo
;;-------------------------------------------
(defun make-text-middle (pos txt h / len en)
  (setq len (* h (strlen txt) 0.6))
  (setq en
    (entmakex
      (list
        '(0 . "TEXT")
        (cons 10 (list (- (car pos) (/ len 2.0))
                       (- (cadr pos) (/ h 2.0))))
        (cons 40 h)
        (cons 1 txt)
        '(50 . 0)
        '(7 . "STANDARD")
      )
    )
  )
  en
)

;;-------------------------------------------
;; Các hàm phụ (giữ nguyên như trước)
;;-------------------------------------------
(defun get-pline-pts (ename / lst)
  (setq lst '())
  (foreach d (entget ename)
    (if (= (car d) 10)
      (setq lst (append lst (list (cdr d))))
    )
  )
  lst
)

(defun pline-to-lines (pts closed / lines n i)
  (setq lines '())
  (setq n (length pts))
  (setq i 0)
  (while (< i (- n 1))
    (setq lines (cons (list (nth i pts) (nth (1+ i) pts)) lines))
    (setq i (1+ i))
  )
  (if closed
    (setq lines (cons (list (nth (- n 1) pts) (nth 0 pts)) lines))
  )
  lines
)

(defun pt-on-line? (p a b / cross dot len2)
  (setq cross (- (* (- (car b) (car a)) (- (cadr p) (cadr a)))
                 (* (- (cadr b) (cadr a)) (- (car p) (car a)))))
  (setq dot (+ (* (- (car p) (car a)) (- (car b) (car a)))
               (* (- (cadr p) (cadr a)) (- (cadr b) (cadr a)))))
  (setq len2 (+ (expt (- (car b) (car a)) 2) (expt (- (cadr b) (cadr a)) 2)))
  (and (< (abs cross) 1e-6) (<= 0 dot) (<= dot len2))
)

(defun count-vectors (pt lines / count a b)
  (setq count 0)
  (foreach line lines
    (setq a (nth 0 line))
    (setq b (nth 1 line))
    (cond
      ((equal pt a 1e-6) (setq count (+ count 1)))
      ((equal pt b 1e-6) (setq count (+ count 1)))
      ((and (not (equal pt a 1e-6)) (not (equal pt b 1e-6)) (pt-on-line? pt a b))
       (setq count (+ count 2)))
    )
  )
  count
)

(defun vectors-at-pt (pt lines / vecs a b)
  (setq vecs '())
  (foreach line lines
    (setq a (nth 0 line))
    (setq b (nth 1 line))
    (cond
      ((equal pt a 1e-6) (setq vecs (cons (list (- (car b) (car a)) (- (cadr b) (cadr a))) vecs)))
      ((equal pt b 1e-6) (setq vecs (cons (list (- (car a) (car b)) (- (cadr a) (cadr b))) vecs)))
      ((and (not (equal pt a 1e-6)) (not (equal pt b 1e-6)) (pt-on-line? pt a b))
       (setq vecs (cons (list (- (car b) (car a)) (- (cadr b) (cadr a))) vecs))
       (setq vecs (cons (list (- (car a) (car b)) (- (cadr a) (cadr b))) vecs))
      )
    )
  )
  vecs
)

(defun vec-angle (v / ang)
  (setq ang (atan (cadr v) (car v)))
  (if (< ang 0) (+ ang (* 2 pi)) ang)
)

(defun vec-scale (v f / len)
  (setq len (sqrt (+ (expt (car v) 2) (expt (cadr v) 2))))
  (if (> len 1e-6)
    (list (* (car v) (/ f len)) (* (cadr v) (/ f len)))
    '(0 0)
  )
)

(defun my-mod (a b)
  (- a (* b (fix (/ a b)))))

;;-------------------------------------------
;; Lệnh chính: Corner insert - Chèn góc để thống kê tính toán phụ kiện Panel
;;-------------------------------------------
(defun c:CISP ( / ss ent ed typ pts all-lines vertex-count pt num vecs n i v1 v2 v1-n v2-n bisector mid ang ang-small v1-small v2-small created-texts ent-num ent-ang)
  ;; Chiều cao chữ
  (setq tmp (getreal (strcat "\nText height <" (rtos *txt_h* 2 0) ">: ")))
  (if tmp (setq *txt_h* tmp))

  ;; Chọn LINE/LWPOLYLINE
  (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))
  (if (not ss) (progn (prompt "\nNothing selected.") (exit)))

  ;; Thu thập tất cả line
  (setq all-lines '())
  (repeat (sslength ss)
    (setq ent (ssname ss 0))
    (setq ss (ssdel ent ss))
    (setq ed (entget ent))
    (setq typ (cdr (assoc 0 ed)))
    (cond
      ((= typ "LINE")
       (setq a (cdr (assoc 10 ed)))
       (setq b (cdr (assoc 11 ed)))
       (if (and a b) (setq all-lines (cons (list a b) all-lines)))
      )
      ((= typ "LWPOLYLINE")
       (setq pts (get-pline-pts ent))
       (setq closed (= (logand (cdr (assoc 70 ed)) 1) 1))
       (if pts (setq all-lines (append all-lines (pline-to-lines pts closed))))
      )
    )
  )

  ;; Tạo danh sách đỉnh và đếm vector
  (setq vertex-count '())
  (foreach line all-lines
    (foreach pt line
      (if (not (assoc pt vertex-count))
        (setq vertex-count (cons (cons pt 0) vertex-count))
      )
    )
  )
  (setq vertex-count
    (mapcar
      (function (lambda (v) (cons (car v) (count-vectors (car v) all-lines))))
      vertex-count
    )
  )

  ;; Chèn số vector và góc, lưu text mới
  (setq created-texts '())
  (foreach v vertex-count
    (setq pt (car v))
    (setq num (cdr v))
    ;; Số vector
    (setq ent-num (make-text-middle pt (itoa num) *txt_h*))
    (setq created-texts (cons ent-num created-texts))

    ;; Vector tại điểm
    (setq vecs (vectors-at-pt pt all-lines))
    (setq vecs (vl-sort vecs (function (lambda (v1 v2) (< (vec-angle v1) (vec-angle v2))))))

    (setq n (length vecs))
    (setq i 0)
    (while (< i n)
      (setq v1 (nth i vecs))
      (setq v2 (nth (my-mod (+ i 1) n) vecs))
      (setq v1-n (vec-scale v1 1.0))
      (setq v2-n (vec-scale v2 1.0))

      ;; Tính góc
      (setq ang (- (vec-angle v2) (vec-angle v1)))
      (if (< ang 0) (setq ang (+ ang (* 2 pi))))
      (setq ang (* 180.0 (/ ang pi)))

      ;; Xử lý đỉnh 2 vector
      (if (= n 2)
        (progn
          (setq ang-small ang)
          (setq v1-small v1-n)
          (setq v2-small v2-n)
          (if (> ang 180.0)
            (progn
              (setq ang-small (- 360.0 ang))
              (setq v1-small v2-n)
              (setq v2-small v1-n)
            )
          )
          ;; Góc nhỏ
          (setq bisector (vec-scale (mapcar '+ v1-small v2-small) (* 2.0 *txt_h*)))
          (setq ent-ang (make-text-middle (mapcar '+ pt bisector) (rtos ang-small 2 1) *txt_h*))
          (setq created-texts (cons ent-ang created-texts))
          ;; Góc lớn
          (setq bisector-large (mapcar '- bisector))
          (setq ent-ang (make-text-middle (mapcar '+ pt bisector-large) (rtos (- 360.0 ang-small) 2 1) *txt_h*))
          (setq created-texts (cons ent-ang created-texts))
          (setq i n)
        )
        ;; Đỉnh ≥3 vector
        (progn
          (if (equal ang 180.0 1e-6)
            (setq bisector (vec-scale (list (- (cadr v1-n)) (car v1-n)) (* 2.0 *txt_h*)))
            (setq bisector (vec-scale (mapcar '+ v1-n v2-n) (* 2.0 *txt_h*)))
          )
          (if (> ang 180.0) (setq bisector (mapcar '- bisector)))
          (setq mid (mapcar '+ pt bisector))
          (setq ent-ang (make-text-middle mid (rtos ang 2 1) *txt_h*))
          (setq created-texts (cons ent-ang created-texts))
          (setq i (1+ i))
        )
      )
    )
  )

  ;;-------------------------------------------
  ;; Chuyển đổi text vừa tạo
  ;;-------------------------------------------
  (foreach ent created-texts
    (setq ed (entget ent))
    (setq txt (cdr (assoc 1 ed)))
    (setq ang-val (atof txt))
    (cond
      ((equal ang-val 90.0 1e-3) (entmod (subst (cons 1 "T") (assoc 1 ed) ed)))
      ((equal ang-val 270.0 1e-3) (entmod (subst (cons 1 "N") (assoc 1 ed) ed)))
      ((equal ang-val 135.0 1e-3) (entmod (subst (cons 1 "H") (assoc 1 ed) ed)))
      (T (entdel ent))
    )
  )

  (prompt "\nXong rồi đấy, T là điểm bo góc trong, N là điểm bo góc ngoài, H là điểm bo góc hồi 135°.")
  (princ "\nTác giả: Nguyễn Văn Thương - Phone: 03.3626.3629")
  (princ)
)