Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
victor85

[Yêu cầu] Nhờ viết lisp add đối tượng vào block

Các bài được khuyến nghị

Đặt vấn đề: Mình có nhu cầu sử dụng block nhiều để quản lý bản vẽ và chỉnh sửa block đôi khi khá mất thời gian và công sức đặc biệt với các máy tính cấu hình không thực sự cao. Mình có ý tưởng là dùng lisp để thêm đối tương vào block tương tự như vào block bằng refedit rồi add đối tượng vào. Tuy nhiên như mình nói quá trình làm thủ công đó khi lặp lại nhiều thì khá mất thời gian. Kính mong các bác viết dùm lisp cụ thể như sau:

 + Đầu vào: Lisp : add_ob_block

  Gõ Lệnh: aob

  Chọn block cần chỉnh sửa -> enter  

  Chọn đối tượng muốn thêm vào block -> enter

  Kết quả block add thêm đối tượng đã chọn như mong muốn ( Ví dụ: tỷ lệ scale của block là 1.5 theo cả 3 tọa độ X, Y, Z thì add đối tượng ngoài không gian model vào cũng vẫn là tỷ lệ đó; nói nôm na là y hệt như thao tác lệnh refedit add đối tượng vào block được cụ thể hóa bằng líp thôi ạ)

Em kính mong các bác xuống tay giúp đỡ ạ. Chân thành cảm ơn các bác và chúc các bác tuần làm việc mới vui vẻ hiệu quả ạ :)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cái này hình như có rồi? Thử cái này:

 

(vl-load-com)
(defun AddObjectsToBlock (ss blk / doc objblk objlst pt p0)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ;  (setq docs (vla-get-Documents (vlax-get-acad-object))
  objlst (SS->Objlist ss)
  objblk (vlax-ename->vla-object blk)
  pt (vlax-variant-value (vla-get-InsertionPoint objblk))
  p0 (vlax-3d-point '(0 0 0)))
 (foreach obj objlst (vla-Move obj pt p0))
 (vla-CopyObjects doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))) objlst))
  (vla-Item (vla-get-Blocks doc) (vla-get-Name objblk))) ;ten block, VD "Block_A"
 (foreach obj objlst (vla-Delete obj))
 (vla-Regen doc acAllViewports))
(defun SS->Objlist (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
;----- Test 
(defun C:AOB( / ss blk)
 (princ "\nChon cac doi tuong can add... ")
 (setq ss (ssget))
 (setq blk (car (entsel "\nChon Block: ")))
 (AddObjectsToBlock ss blk))
(defun C:XOA( / ent)
 (setq ent (car (nentsel "\nChon doi tuong can xoa: ")))
 (DeleteObjectFromBlock ent))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Nó báo như này là sao ah bác ơi:

"aob_xoa.lsp successfully loaded.
Command: ; error: syntax error
Command: aob Unknown command "AOB".  Press F1 for help."

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lỗi forum. Bạn down lại cái này:

 

(vl-load-com)
(defun AddObjectsToBlock (ss blk / doc objblk objlst pt p0)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ;  (setq docs (vla-get-Documents (vlax-get-acad-object))
  objlst (SS->Objlist ss)
  objblk (vlax-ename->vla-object blk)
  pt (vlax-variant-value (vla-get-InsertionPoint objblk))
  p0 (vlax-3d-point '(0 0 0)))
 (foreach obj objlst (vla-Move obj pt p0))
 (vla-CopyObjects doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))) objlst))
  (vla-Item (vla-get-Blocks doc) (vla-get-Name objblk))) ;ten block, VD "Block_A"
 (foreach obj objlst (vla-Delete obj))
 (vla-Regen doc acAllViewports))
(defun SS->Objlist (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
;----- Test 
(defun C:AOB( / ss blk)
 (princ "\nChon cac doi tuong can add... ")
 (setq ss (ssget))
 (setq blk (car (entsel "\nChon Block: ")))
 (AddObjectsToBlock ss blk))
  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Hì, bác post lại nốt luôn cái đoạn xóa đi, lisp chạy ổn rôi bác ạ!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Đây!

 

(vl-load-com)
(defun AddObjectsToBlock (ss blk / doc objblk objlst pt p0)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ;  (setq docs (vla-get-Documents (vlax-get-acad-object))
  objlst (SS->Objlist ss)
  objblk (vlax-ename->vla-object blk)
  pt (vlax-variant-value (vla-get-InsertionPoint objblk))
  p0 (vlax-3d-point '(0 0 0)))
 (foreach obj objlst (vla-Move obj pt p0))
 (vla-CopyObjects doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))) objlst))
  (vla-Item (vla-get-Blocks doc) (vla-get-Name objblk))) ;ten block, VD "Block_A"
 (foreach obj objlst (vla-Delete obj))
 (vla-Regen doc acAllViewports))
(defun SS->Objlist (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
;----- Test 
(defun C:AOB( / ss blk)
 (princ "\nChon cac doi tuong can add... ")
 (setq ss (ssget))
 (setq blk (car (entsel "\nChon Block: ")))
 (AddObjectsToBlock ss blk))
(defun C:XOA( / ent)
 (setq ent (car (nentsel "\nChon doi tuong can xoa: ")))
 (DeleteObjectFromBlock ent))
(defun DeleteObjectFromBlock (ent / doc blk)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
   ent (vlax-ename->vla-object ent)
   blk (vla-ObjectIdToObject doc (vla-get-OwnerID ent)))
  (vla-Delete ent)
  (vla-Regen doc acAllViewports)
  (vla-get-Count blk))
  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Lỗi do download của forum

Mở bằng VLIDE rồi dùng REPLACE (shorcut Ctr+H) xóa các ký tự lạ (mã ascii là C2 và A0)

(Hình dạng của ký tự lạ có thể khác nếu code page khác 932, trong ô Find what là 2 ký tự nhưng hình vuông màu đen trong cửa sổ code không thấy được )

 

19626_err.jpg

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đây!

(vl-load-com)
(defun AddObjectsToBlock (ss blk / doc objblk objlst pt p0)
 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ;  (setq docs (vla-get-Documents (vlax-get-acad-object))
  objlst (SS->Objlist ss)
  objblk (vlax-ename->vla-object blk)
  pt (vlax-variant-value (vla-get-InsertionPoint objblk))
  p0 (vlax-3d-point '(0 0 0)))
 (foreach obj objlst (vla-Move obj pt p0))
 (vla-CopyObjects doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length objlst)))) objlst))
  (vla-Item (vla-get-Blocks doc) (vla-get-Name objblk))) ;ten block, VD "Block_A"
 (foreach obj objlst (vla-Delete obj))
 (vla-Regen doc acAllViewports))
(defun SS->Objlist (ss / i lst)
 (repeat (setq i (sslength ss))
  (setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
;----- Test 
(defun C:AOB( / ss blk)
 (princ "\nChon cac doi tuong can add... ")
 (setq ss (ssget))
 (setq blk (car (entsel "\nChon Block: ")))
 (AddObjectsToBlock ss blk))
(defun C:XOA( / ent)
 (setq ent (car (nentsel "\nChon doi tuong can xoa: ")))
 (DeleteObjectFromBlock ent))
(defun DeleteObjectFromBlock (ent / doc blk)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
   ent (vlax-ename->vla-object ent)
   blk (vla-ObjectIdToObject doc (vla-get-OwnerID ent)))
  (vla-Delete ent)
  (vla-Regen doc acAllViewports)
  (vla-get-Count blk))

Nhờ anh sửa giúp lisp này thành move đối tượng ra khỏi block tại vị trí của nó luôn với nhé! Thanks anh!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×