Lisp dời điểm chèn block

Bạn có bản vẽ mà trong đó có cái block đã chèn nhiều vị trí, rotate, scale, mirror chuyễn layer nói chung là lung tung hết cả và đến 1 lúc bạn nhận ra cái điểm chèn của nó lúc tạo ra lại không nằm đúng chổ mình ưng tí nào bạn muốn chuyển cái điểm chèn này vào ngay tâm block để tiện chỉnh sửa làm sao đây :
-Dể òm mà dùng lệnh BEDIT định lại cái basepoint là xong ................ đúng là cái điểm chèn nằm chổ ưng ý rồi nhưng mấy cái block thì nhảy loạn xạ không còn mằm chổ cũ nửa
-Bạn muốn là dời điểm chèn nhưng mấy cái block đứng im kìa ==> đây dùng lisp vậy.
-Tên lệnh: DBL.-Chọn Block cần chỉnh.-Chọn điểm chèn mới.=> Lisp báo ra tên block và số lượng của block vừa chỉnh (tất nhiên là đã làm công việc chỉnh xong rồi đúng cả với trường hợp block bị mirror, tỉ lệ x và y khác nhau, góc quay )
-Ưu điểm không thay đổi tên block sau khi hoàn tất công việc và không có block rác.
-Nhược điểm: nếu block lựa chọn còn nằm trong 1 block khác nửa thì quá trình thay đổi sẽ không hoàn tất dẩn đến việc song song tồn tại block cũ và block trung gian lúc này các block đã dời điểm chèn sẽ mang tên block trung gian bao gồm tên cũ + taothem.

Bạn copy nội dung và tạo file lisp hay tải file về cũng được!

(defun c:dbl ()
(command "undo" "be")

(setq doituong1 (entsel "\nChon Block muon chinh diem chen"))
(while
(or
(null doituong1)
(/= "INSERT" (cdr (assoc 0 (entget (car doituong1)))))
)
(princ "\nDoi tuong khong phai la Block! Chon lai")
(setq doituong1 (entsel "\nChon Block muon chinh diem chen"))
)

(command "ucs" "ob" doituong1)
(setq DIEMCHENMOI (getpoint "\n Chon diem chen moi cho Block nay :"))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "layer" "s" 0 "")
(setq doituong (car doituong1))
(setq doituong (entget doituong))
(setq TENKHOI (cdr (assoc 2 doituong)))
(setq TENKHOIMOI (strcat TENKHOI "TAOTHEM"))
(setq TYLEX (cdr (assoc 41 doituong)))
(setq TYLEY (cdr (assoc 42 doituong)))
(setq DIEMTINH (list (/ (car DIEMCHENMOI) TYLEX) (/ (cadr DIEMCHENMOI) TYLEY)))
(setq XDIEMTINH (car DIEMTINH))
(setq YDIEMTINH (cadr DIEMTINH))
(setq DAICHUAS (distance (list 0 0) DIEMTINH))
(setq GOCCHUAS (angle (list 0 0) DIEMTINH))
(setq DIEMCHENTUONGDOI (polar (LIST 0 0) GOCCHUAS DAICHUAS))
(command ".INSERT" TENKHOI (LIST 0 0) 1 1 0)
(Command "EXPLODE" "last" "")
(Command "Block" TENKHOIMOI DIEMCHENTUONGDOI "Previous" "")
(command "ucs" "p")


(setq xx (ssget "X" (list( cons 0 "INSERT") (cons 2 TENKHOI))))

(setq L 0)
(setq M (sslength XX))
(while (< L M)
(setq DTs (ssname XX L))
(setq DTMs (entget DTs))
(command "ucs" "ob" DTs)
(setq TYLEX1 (cdr (assoc 41 DTMs)))
(setq TYLEY1 (cdr (assoc 42 DTMs)))
(setq DIEMDOI (list (* XDIEMTINH TYLEX1) (* YDIEMTINH TYLEY1)))

(setq DTMs (subst (cons 2 TENKHOIMOI) (assoc 2 DTMs) DTMs))
(entmod DTMs)
(setq DIEMDOI (trans DIEMDOI 1 0))
(setq DTMs (subst (cons 10 DIEMDOI) (assoc 10 DTMs) DTMs))
(entmod DTMs)
;(command "move" DTs "" (list 0 0) DIEMDOI)
(command "ucs" "p")
(setq L (1+ L))
)


(setvar "osmode" luubatdiem)
(Command "Purge" "B" TENKHOI "Y" "Y")
(command "rename" "b" TENKHOIMOI TENKHOI)
(command "undo" "end")

(princ (strcat "\nVua chinh tam cua block <" TENKHOI "> :" (itoa L) " doi tuong"))
(setvar "MODEMACRO" "**CHUC BAN LAM VIEC HIEU QUA** PHAM QUOC DUY - BINH SON - QUANG NGAI")
(Princ))

Tải về