Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
9 replies to this topic

#1 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 11 May 2015 - 09:03 AM

Đặ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ả ạ :)


  • 0

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 May 2015 - 09:52 AM

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))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 11 May 2015 - 11:43 AM

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."

 


  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 May 2015 - 11:50 AM

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))

  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 11 May 2015 - 11:57 AM

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 ạ!


  • 0

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 May 2015 - 12:11 PM

Đâ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))

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 411 Bài viết
Điểm đánh giá: 88 (tàm tạm)

Đã gửi 11 May 2015 - 04:40 PM

@Ha, mình test máy mình thì bị lỗi này (mình dùng cad 2016)  APPLOAD aob.lsp successfully loaded. Command: ; error: syntax error


  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 11 May 2015 - 04:45 PM

Bạn mở bằng vlide xem lỗi không. Forum hay bị lỗi. Tôi đang dùng di động nên không test được.
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 13 May 2015 - 02:46 PM

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


  • 1

#10 pawuta

pawuta

    biết lệnh move

  • Members
  • PipPipPip
  • 126 Bài viết
Điểm đánh giá: -12 (hơi kém)

Đã gửi 16 September 2015 - 01:09 PM

 

Đâ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!


  • 0