Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
rongvuong

[YÊU CẦU] Xin lisp chuyển layer của các đối tượng trong block về cùng layer của block

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

phamthanhbinh    3.123

nếu đã có xin mõi người share giúp

em tìm mãi ko thấy

Hề hề hề,

Lisp này chắc chắn đã có trên diễn đàn. Chịu khó kiếm một chút sẽ thấy.Gõ từ khóa cbl thử coi.

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
Doan Van Ha    2.676

Lisp chuyển tất cả đối tượng trong block về cùng layer của block.

;Doan Van Ha - CADViet.com - Ngay 05/01/2013
;Chuc nang: chuyen tat ca doi tuong trong block ve cung layer cua block.
(defun C:HA ( / acdoc acblk ss )
 (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
       	acblk (vla-get-blocks acdoc))
 (if (setq ss (ssget "_+.:E:S" '((0 . "INSERT"))))
(LM:ApplytoBlockObjects acblk (cdr (assoc 2 (entget (ssname ss 0))))
 	(function
   	(lambda (obj) (vla-put-Layer obj (vla-get-Layer (vlax-ename->vla-object (ssname ss 0))))))))
 (princ))
(defun LM:ApplytoBlockObjects ( _acblocks _blockname _function / result )
 ((lambda ( _function / def ) 
 	(if
   	(not
     	(vl-catch-all-error-p
       	(setq def
         	(vl-catch-all-apply 'vla-item (list _acblocks  _blockname)))))
   	(vlax-for obj def (setq result (cons (_function obj) result)))))
(eval _function))
 (reverse result))

  • Vote tăng 4

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
duy782006    1.373

Chi bằng ta đổi tất cả các đối tượng trong block thành layer 0 màu bylayer như vậy nó sẽ tự thành như ý nhỉ.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;sua ma dxf block
;;;Cu phap su dung (duy:block_s_dxf block mdxf thanh)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun block_s_dxf (blk mdxf thanh /  e el name ob lname name mdxf thanh)
(setq name (cdr (assoc 2 (entget blk))))
(if (not (member name lname))
(progn
(setq lname (append lname (list name)))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" name))))
(while e
(setq el (entget e))

(cond 
((wcmatch (cdr (assoc 0 el)) "INSERT") (block_s_dxf e mdxf thanh) )
)

(setq Ent (subst (cons mdxf thanh) (assoc mdxf el) el))
(entmod ent)
(setq e (entnext e))  
);while
);progn
);if
(command ".move" (ssget "x" (list (cons 0 "INSERT")(cons 2 name))) "" (list 0 0 0) (list 0 0 0))
)

(DEFUN C:dlb ()
(setq dttd (car(entsel "Chon BLOCK!")))
(block_s_dxf dttd 8 "0")
(block_s_dxf dttd 62 256)
)
  • 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
Polyline    18

Nhưng yêu cầu của người ta là chuyển các đối tượng bên trong Block về cùng layer với Block mà bạn! Như vậy có thể có nhiều Block khác nhau nằm ở nhiều layer khác nhau.

 

P/S: Trong code của bạn có lệnh Move từ (0,0) về (0,0) để làm gì vậy bạn?

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
Polyline    18

...Lisp này chắc chắn đã có trên diễn đàn...

Có phải ở đây không bạn:

http://www.cadviet.com/forum/topic/31768-nho-viet-lisp-doi-mau-ve-bylayer/?do=findComment&comment=125869

Mình tìm thấy các lệnh CBL, nhưng không có cái nào đáp ứng đúng yêu cầu của topic này 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
duy782006    1.373

Nhưng yêu cầu của người ta là chuyển các đối tượng bên trong Block về cùng layer với Block mà bạn! Như vậy có thể có nhiều Block khác nhau nằm ở nhiều layer khác nhau.

 

P/S: Trong code của bạn có lệnh Move từ (0,0) về (0,0) để làm gì vậy bạn?

1.Ở đây là chuyễn tất cả các đtưiợng trong block (kể cả lồng nhau) về layer 0 và màu bylayer. Còn layer của block không có thay đổi. Nghĩa là nếu block uyuy có trên bản vẽ 1000 cái và thuộc 1000 layer khác nhau thì chỉ cần thao tác với 1 block uyuy bất kỳ lúc này tự khắc các block uyuy có trong bản vẽ sẽ hiển thị thành màu mà block đang thuộc (đây là tính chất hay mà khi tạo block mình hay tạo từ layer 0 và màu bylayer)

2.Move như vậy tác dụng cập nhật trạng thái hiển thị của block vừa được sửa (cad2007 nếu ko làm vậy thì chưa cập nhật trạng thái hiển thị)

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
Doan Van Ha    2.676

Xét cả block lồng nhiều tầng.

 

;; Convert Layer cua cac doi tuong ben trong block (co the long nhau) ve cung Layer cua Block chinh.
;; Doan Van Ha - CadViet.com - ngay 18/7/2013
(defun C:HA ( / ent1 obj1 )
 (if (setq ent1 (car (entsel "\nChon Block: ")))
  (foreach obj (Get_lst_Obj (vla-get-Name (setq obj1 (vlax-ename->vla-object ent1))))
   (vla-put-Layer obj (vla-get-Layer obj1))))
 (vla-update obj1))
(defun Get_lst_Obj (blkname / lst)
 (vlax-for each (vla-Item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object))) blkname)
  (if (/= (vla-get-ObjectName each) "AcDbBlockReference")
   (setq lst (cons each lst))
   (setq lst (append (Get_lst_Obj (vla-get-Name each)) lst))))
 lst)
  • Vote tăng 5

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
Polyline    18

Vote!!! :D

Đúng là với block lồng nhiều tầng, dùng đệ quy cho ra kết quả không thể tốt hơn được!! Đợt này bác HA viết trực tiếp không dùng anh LeeMac nữa mà kết quả vẫn ngắn gọn.

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

Lisp bác Hà hay tuyệt, tuy nhiên nếu có thể chọn 1 lúc nhiều đối tượng block bằng cách quét chuột chứ ko phải chọn từng cái thì nó sẽ lợi hại hơn nhiều bác à.

Hy vọng bác dành ít thời gian cải tiến cho mọi người có lisp hay để dùng.

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
ndtnv    396

Đầu tiên xin khen ngợi bạn đã viết nhiều Lisp giúp đỡ rất nhiều người. Đối với lisp này tôi không dùng vì kết quả sẽ thay đổi linetype và lineweight của các đối tượng trong block.

Tôi có 1 vài góp ý bạn Doan Van Ha như sau:

1. Lisp nào của bạn cũng dùng lệnh C:HA nên người nào đó bấm Download không cẩn thận thì sẽ ghi đè lên các file cũ.

2. Khi undo sẽ không về trạng thái cũ

3. Bạn dùng code quá rút gọn mà bỏ qua thời gian thi hành (mặc dù không đáng kể đối với các block nhỏ):

-Nếu block có nhiều block con cùng tên, Get_lst_Obj sẽ trả về rất nhiều đối tượng trùng nhau.

-Hàm vla-get-Layer thực hiện quá nhiều lần như bạn ketxu nhận xét ở trên.

  • 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
Polyline    18

Theo mình, về tính thực dụng thì Lisp của bác HA hoàn toàn đạt yêu cầu đã đặt ra.
Về code thì cũng có vài vấn đề, ví dụ nó sẽ báo lỗi nếu người dùng nhấn enter ở dong nhắc "Chon Block: ".

Tuy nhiên, nếu lấy mục tiêu là tính ứng dụng của nó thì những lỗi này hoàn toàn không đáng ngại ... dùng tốt!!

(tốt hơn cả của bác Lee Mac nữa là...) :D

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
Doan Van Ha    2.676

Chưa hạn chế được hết tất cả các khiếm khuyết, nhưng cái này có "khá" hơn.

 

;; Convert Layer cua cac doi tuong ben trong block (co the long nhau) ve cung Layer cua Block chinh. De Undo tat ca: dung lenh "U" + "Regen"
;; Doan Van Ha - CadViet.com - ngay 21/7/2013
(defun C:HA ( / doc blkname lay)
 (princ "\nChon cac Blocks...")
 (if (ssget '((0 . "INSERT")))
  (progn
   (vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
    (setq blkname (vla-get-Name obj)
          lay (vla-get-Layer obj))
    (mapcar '(lambda(o) (vla-put-Layer o lay)) (Get_lst_Obj doc blkname)))
   (vla-Regen doc acActiveViewport))))
(defun Get_lst_Obj (doc blkname / lst)
 (vlax-for blk (vla-Item (vla-get-Blocks doc) blkname)
  (if (/= (vla-get-ObjectName blk) "AcDbBlockReference")
   (if (not (vl-position blk lst))
    (setq lst (cons blk lst)))
   (setq lst (append (Get_lst_Obj doc (vla-get-Name blk)) lst)))))
 
  • 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

 

Chưa hạn chế được hết tất cả các khiếm khuyết, nhưng cái này có "khá" hơn.

 

;; Convert Layer cua cac doi tuong ben trong block (co the long nhau) ve cung Layer cua Block chinh. De Undo tat ca: dung lenh "U" + "Regen"
;; Doan Van Ha - CadViet.com - ngay 21/7/2013
(defun C:HA ( / doc blkname lay)
 (princ "\nChon cac Blocks...")
 (if (ssget '((0 . "INSERT")))
  (progn
   (vlax-for obj (vla-get-ActiveSelectionSet (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))))
    (setq blkname (vla-get-Name obj)
          lay (vla-get-Layer obj))
    (mapcar '(lambda(o) (vla-put-Layer o lay)) (Get_lst_Obj doc blkname)))
   (vla-Regen doc acActiveViewport))))
(defun Get_lst_Obj (doc blkname / lst)
 (vlax-for blk (vla-Item (vla-get-Blocks doc) blkname)
  (if (/= (vla-get-ObjectName blk) "AcDbBlockReference")
   (if (not (vl-position blk lst))
    (setq lst (cons blk lst)))
   (setq lst (append (Get_lst_Obj doc (vla-get-Name blk)) lst)))))
 

Anh cho em hỏi luôn. em tải lisp này về, và dùng tại sao block của em không đổi về màu 8 ? mà vẫn giữ nguyên màu trắng???

em muốn dùng lisp chuyển toàn bộ block trong file đính kèm, chuyển thành màu 8 nhưng block vẫn giữ nguyên.

  • Vote giảm 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
htqk9    0

Chi bằng ta đổi tất cả các đối tượng trong block thành layer 0 màu bylayer như vậy nó sẽ tự thành như ý nhỉ.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;sua ma dxf block
;;;Cu phap su dung (duy:block_s_dxf block mdxf thanh)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun block_s_dxf (blk mdxf thanh /  e el name ob lname name mdxf thanh)
(setq name (cdr (assoc 2 (entget blk))))
(if (not (member name lname))
(progn
(setq lname (append lname (list name)))
(setq e (cdr (assoc -2 (tblsearch "BLOCK" name))))
(while e
(setq el (entget e))

(cond 
((wcmatch (cdr (assoc 0 el)) "INSERT") (block_s_dxf e mdxf thanh) )
)

(setq Ent (subst (cons mdxf thanh) (assoc mdxf el) el))
(entmod ent)
(setq e (entnext e))  
);while
);progn
);if
(command ".move" (ssget "x" (list (cons 0 "INSERT")(cons 2 name))) "" (list 0 0 0) (list 0 0 0))
)

(DEFUN C:dlb ()
(setq dttd (car(entsel "Chon BLOCK!")))
(block_s_dxf dttd 8 "0")
(block_s_dxf dttd 62 256)
)

@Pham Quoc DuyCái này ngon rồi nhưng bạn có thể edit lại tý xíu phần select object như trong cad không...ví dụ chọn đối tượng theo p, c, w, l, cp, wp...thk so much

Chỉnh sửa theo htqk9

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


×