Lệnh DPL

Lisp giúp dim nhanh theo Polyline chọn trước.

Cách sử dụng

Gõ lệnh DPL

Nhập chiều cao Text

Nhập Textstyle cho Text

Chọn các Polyline muốn dim.

Enter để kết thúc lệnh

Ảnh do thành viên nhóm http://tdz.lisp.vn cung cấp

1 Thêm class [DPL] Dim nhanh Polyline.lsp

Lưu mã sau dưới dạng tệp tin [DPL] Dim nhanh Polyline.lsp

Code:

(defun c:DPL (/ ss ent elist points i pt1 pt2 len ang ang-deg txtpt dimtxt textheight offset rot)

  (vl-load-com)

  (defun midpoint (p1 p2)
    (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2))

  (defun get-vertex-list (e)
    (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) e)))

  (initget 6)
  (setq textheight (getreal "\nChiều cao chữ (Enter = 250): "))
  (if (or (not textheight) (< textheight 1)) (setq textheight 250))

  (setq textstyle (getstring t "\nNhập tên style chữ (Enter = Standard): "))
  (if (= textstyle "") (setq textstyle "Standard"))

  (setq offset (* textheight 1.2))

  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if ss
    (progn
      (setq ent (ssname ss 0))
      (setq elist (entget ent))
      (setq points (get-vertex-list elist))

      (if (= (logand (cdr (assoc 70 elist)) 1) 1)
        (setq points (append points (list (car points))))
      )

      (setq i 0)
      (repeat (- (length points) 1)
        (setq pt1 (nth i points))
        (setq pt2 (nth (1+ i) points))

        (setq len (distance pt1 pt2))
        (setq ang (angle pt1 pt2))
        (setq ang-deg (* ang (/ 180.0 pi)))
        (setq rot (if (and (>= ang-deg 90.0) (< ang-deg 270.0)) (+ ang pi) ang))

        (setq txtpt (polar (midpoint pt1 pt2) (+ ang (/ pi 2)) offset))
        (setq dimtxt (rtos len 2 2))

        (prompt (strcat "\n→ Đoạn " (itoa i) ": " dimtxt))

        (entmake
          (list
            (cons 0 "TEXT")
            (cons 8 "DIM_TEXT")
            (cons 7 textstyle)
            (cons 1 dimtxt)
            (cons 10 txtpt)
            (cons 11 txtpt)
            (cons 40 textheight)
            (cons 50 rot)
            (cons 72 4)
            (cons 73 2)
          )
        )

        (setq i (1+ i))
      )
    )
    (prompt "\n❌ Không có Polyline nào được chọn.")
  )
  (princ)
)