[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

[rongvuong 1]

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

em tìm mãi ko thấy

[phamthanhbinh 3.146]

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.

[Doan Van Ha 3.191]

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

[ketxu 2.984]

Gọn quá đâm ra lần nào cũng phải tính lại layer bác ạ :)

[Polyline 19]

Lisp của bác HA rất tốt đối với trường hợp đơn giản. Với Block lồng nhau thì vẫn chưa xử lý triệt để được.

[duy782006 1.544]

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

[Polyline 19]

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?

[Polyline 19]

...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ả!

[duy782006 1.544]

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

[Doan Van Ha 3.191]

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)

[Polyline 19]

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.

[dragontalon0802 4]

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.

[ndtnv 481]

Đầ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.

[Polyline 19]

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

[Doan Van Ha 3.191]

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

[nguyencanh160890 1]

 

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.

[htqk9 1]

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 Tháng 10 29, 2014 theo htqk9

[tuhaitam 0]

Vào lúc 18/7/2013 tại 10:56, duy782006 đã nói:

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

• dlb.lsp
  
• [✎]
   

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

lisp này đúng cái mình đang cần nhưng bạn có thể sửa lại cho nó quét hết bản vẽ thay vì chọn từng block không bạn, cảm ơn bạn trước 

[duy782006 1.544]

19 phút trước, tuhaitam đã nói:

lisp này đúng cái mình đang cần nhưng bạn có thể sửa lại cho nó quét hết bản vẽ thay vì chọn từng block không bạn, cảm ơn bạn trước 

Không.

[saigonnew 0]

Bạn Duy 782006 lisp này có thể quét được cho nhiều block ko bạn ơi

[duy782006 1.544]

Không.

[dieptp 8]

Có 2 lệnh, tùy trường hợp sử dụng. Chuyển các đối tượng (kể cả lồng nhau) về layer 0. Có thể quét nhiều một lúc

BL0,BL00_ change all objects in selected blocks to layer 0 (light).lsp

[saigonnew 0]

Vào lúc 17/9/2019 tại 16:33, dieptp đã nói:

Có 2 lệnh, tùy trường hợp sử dụng. Chuyển các đối tượng (kể cả lồng nhau) về layer 0. Có thể quét nhiều một lúc

BL0,BL00_ change all objects in selected blocks to layer 0 (light).lsp

BL0 xài rất tôt còn BL00 vẫn ko quét được hết các block nhé bạn

[hoangvanloi00005 1]

Thanks mọi người ạ

Phòng khám đa khoa Thái Dương