Nhờ các anh/chị sửa giúp e cái lisp đính kèm ạ

[HauDV 2]

T4_ Trích chi tiết.txt

Ví dụ.dwg

Em chào các anh/chị!

e nhờ các anh chị sửa giúp e cái lisp đính kèm, với nội dung như sau: e có lệnh T4 để tạo nhanh 1 block theo 2 điểm pick, nhưng khi tạo ra block mới e muốn nó có 1 đường bao quanh block đó bằng layer ABC (layer này đã có sẵn) ạ.

em cảm ơn các anh chị!

[Tap.Ve.Cad 24]

Vào lúc 28/2/2026 tại 17:41, HauDV đã nói:

T4_ Trích chi tiết.txt

Ví dụ.dwg

Em chào các anh/chị!

e nhờ các anh chị sửa giúp e cái lisp đính kèm, với nội dung như sau: e có lệnh T4 để tạo nhanh 1 block theo 2 điểm pick, nhưng khi tạo ra block mới e muốn nó có 1 đường bao quanh block đó bằng layer ABC (layer này đã có sẵn) ạ.

em cảm ơn các anh chị!

Bạn dùng thử cái này xem được không nhé: 

(defun c:T4 (/ kw pt1 pt2 minPt maxPt ll ss rect_ent entz oldlayer target_layer *error*)
  (vl-load-com)
  (setq oldlayer (getvar "clayer"))
  (defun *error* (msg)
    (if oldlayer (setvar "clayer" oldlayer))
    (princ)
  )
  (setq target_layer (getstring (strcat "\nNhap ten Layer cho duong bo <" oldlayer ">: ")))
  (if (or (= target_layer "") (not (tblsearch "LAYER" target_layer)))
    (setq target_layer oldlayer)
  )
  (setvar "clayer" "0")
  (initget "Chon Ve")
  (setq kw (getkword "\nChon HCN co san hay Ve moi? [Chon/Ve] <Ve>: "))
  (if (null kw) (setq kw "Ve"))
  (if (= kw "Chon")
    (progn
      (setq rect_ent (car (entsel "\nChon hinh chu nhat: ")))
      (if rect_ent
        (progn
          (vla-getboundingbox (vlax-ename->vla-object rect_ent) 'minPt 'maxPt)
          (setq pt1 (vlax-safearray->list minPt)
                pt2 (vlax-safearray->list maxPt)
                ll (list (car pt1) (cadr pt1))
                ss (ssget "C" pt1 pt2))
          (if ss (ssdel rect_ent ss))
        )
        (exit)
      )
    )
    (progn
      (setq pt1 (getpoint "\nDiem thu nhat: ")
            pt2 (getcorner pt1 "\nDiem thu hai: ")
            ll (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2)))
            ss (ssget "C" pt1 pt2))
      (command "_.RECTANG" "_non" pt1 "_non" pt2)
      (setq rect_ent (entlast))
    )
  )
  (if (or (not ss) (= (sslength ss) 0))
    (progn
      (if (= kw "Ve") (command "_.ERASE" rect_ent ""))
      (exit)
    )
  )
  (vl-cmdf "_.copybase" "_non" ll ss "")
  (vl-cmdf "_.pasteblock" "_non" ll)
  (setq entz (entlast))
  (command "_.XCLIP" entz "" "N" "S" rect_ent)
  (if (= kw "Ve")
    (command "_.ERASE" rect_ent "")
  )
  (setvar "clayer" target_layer)
  (command "_.RECTANG" "_non" pt1 "_non" pt2)
  (setvar "clayer" oldlayer)
  (setq *error* nil)
  (princ)
)

[HauDV 2]

1 giờ trước, Tap.Ve.Cad đã nói:

Bạn dùng thử cái này xem được không nhé: 

(defun c:T4 (/ kw pt1 pt2 minPt maxPt ll ss rect_ent entz oldlayer target_layer *error*)
  (vl-load-com)
  (setq oldlayer (getvar "clayer"))
  (defun *error* (msg)
    (if oldlayer (setvar "clayer" oldlayer))
    (princ)
  )
  (setq target_layer (getstring (strcat "\nNhap ten Layer cho duong bo <" oldlayer ">: ")))
  (if (or (= target_layer "") (not (tblsearch "LAYER" target_layer)))
    (setq target_layer oldlayer)
  )
  (setvar "clayer" "0")
  (initget "Chon Ve")
  (setq kw (getkword "\nChon HCN co san hay Ve moi? [Chon/Ve] <Ve>: "))
  (if (null kw) (setq kw "Ve"))
  (if (= kw "Chon")
    (progn
      (setq rect_ent (car (entsel "\nChon hinh chu nhat: ")))
      (if rect_ent
        (progn
          (vla-getboundingbox (vlax-ename->vla-object rect_ent) 'minPt 'maxPt)
          (setq pt1 (vlax-safearray->list minPt)
                pt2 (vlax-safearray->list maxPt)
                ll (list (car pt1) (cadr pt1))
                ss (ssget "C" pt1 pt2))
          (if ss (ssdel rect_ent ss))
        )
        (exit)
      )
    )
    (progn
      (setq pt1 (getpoint "\nDiem thu nhat: ")
            pt2 (getcorner pt1 "\nDiem thu hai: ")
            ll (list (min (car pt1) (car pt2)) (min (cadr pt1) (cadr pt2)))
            ss (ssget "C" pt1 pt2))
      (command "_.RECTANG" "_non" pt1 "_non" pt2)
      (setq rect_ent (entlast))
    )
  )
  (if (or (not ss) (= (sslength ss) 0))
    (progn
      (if (= kw "Ve") (command "_.ERASE" rect_ent ""))
      (exit)
    )
  )
  (vl-cmdf "_.copybase" "_non" ll ss "")
  (vl-cmdf "_.pasteblock" "_non" ll)
  (setq entz (entlast))
  (command "_.XCLIP" entz "" "N" "S" rect_ent)
  (if (= kw "Ve")
    (command "_.ERASE" rect_ent "")
  )
  (setvar "clayer" target_layer)
  (command "_.RECTANG" "_non" pt1 "_non" pt2)
  (setvar "clayer" oldlayer)
  (setq *error* nil)
  (princ)
)

e cảm ơn a, nhưng nó bị mất tính năng đặt block theo vị trí chỉ định và thừa thao tác chọn layer và chọn cách vẽ. a có thể sửa lại giúp e là vẫn còn chức năng chọn vị trí đặt block, và layer bao quanh block là layer "ABC" (không cần tạo mới vì nó luôn có sẵn) rồi k ạ

 

[Tap.Ve.Cad 24]

Bạn thử lại xem;

 

(defun c:T4 (/ p1 p2 ll ss rect_xclip entz bound_rect oldlayer *error*)
  (vl-load-com)
  (setq oldlayer (getvar "clayer"))
  (defun *error* (msg)
    (if oldlayer (setvar "clayer" oldlayer))
    (princ)
  )
  (setq p1 (getpoint "\nDiem thu nhat: "))
  (if p1
    (progn
      (setq p2 (getcorner p1 "\nDiem thu hai: "))
      (if p2
        (progn
          (setq ss (ssget "C" p1 p2))
          (if (and ss (> (sslength ss) 0))
            (progn
              (setq ll (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2))))
              (setvar "clayer" "0")
              (command "_.RECTANG" "_non" p1 "_non" p2)
              (setq rect_xclip (entlast))
              (vl-cmdf "_.copybase" "_non" ll ss "")
              (vl-cmdf "_.pasteblock" "_non" ll)
              (setq entz (entlast))
              (command "_.XCLIP" entz "" "N" "S" rect_xclip)
              (command "_.ERASE" rect_xclip "")
              (setvar "clayer" "ABC")
              (command "_.RECTANG" "_non" p1 "_non" p2)
              (setq bound_rect (entlast))
              (setvar "clayer" oldlayer)
              (princ "\nChon vi tri dat block: ")
              (command "_.MOVE" entz bound_rect "" "_non" ll PAUSE)
            )
          )
        )
      )
    )
  )
  (setq *error* nil)
  (princ)
)

[HauDV 2]

8 phút trước, Tap.Ve.Cad đã nói:

Bạn thử lại xem;

 

(defun c:T4 (/ p1 p2 ll ss rect_xclip entz bound_rect oldlayer *error*)
  (vl-load-com)
  (setq oldlayer (getvar "clayer"))
  (defun *error* (msg)
    (if oldlayer (setvar "clayer" oldlayer))
    (princ)
  )
  (setq p1 (getpoint "\nDiem thu nhat: "))
  (if p1
    (progn
      (setq p2 (getcorner p1 "\nDiem thu hai: "))
      (if p2
        (progn
          (setq ss (ssget "C" p1 p2))
          (if (and ss (> (sslength ss) 0))
            (progn
              (setq ll (list (min (car p1) (car p2)) (min (cadr p1) (cadr p2))))
              (setvar "clayer" "0")
              (command "_.RECTANG" "_non" p1 "_non" p2)
              (setq rect_xclip (entlast))
              (vl-cmdf "_.copybase" "_non" ll ss "")
              (vl-cmdf "_.pasteblock" "_non" ll)
              (setq entz (entlast))
              (command "_.XCLIP" entz "" "N" "S" rect_xclip)
              (command "_.ERASE" rect_xclip "")
              (setvar "clayer" "ABC")
              (command "_.RECTANG" "_non" p1 "_non" p2)
              (setq bound_rect (entlast))
              (setvar "clayer" oldlayer)
              (princ "\nChon vi tri dat block: ")
              (command "_.MOVE" entz bound_rect "" "_non" ll PAUSE)
            )
          )
        )
      )
    )
  )
  (setq *error* nil)
  (princ)
)

e cảm ơn a, lisp hoạt động tốt rồi ạ!