Chuyển đến nội dung
Diễn đàn CADViet
thanhphatld

chuyển các đối tượng trong block về cùng 1 layer

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

trong bản vẽ của mình có rất nhiều block , mình muốn chuyển tất cả các đối tượng trong tất cả các block về cùng 1 layer thì làm thế nào mong các bác giúp em với, chỉ thực hiện 1 lệnh thui chứ làm từng cái thì lâu quá

  • 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

trong bản vẽ của mình có rất nhiều block , mình muốn chuyển tất cả các đối tượng trong tất cả các block về cùng 1 layer thì làm thế nào mong các bác giúp em với, chỉ thực hiện 1 lệnh thui chứ làm từng cái thì lâu quá

 

Đây Lisp của cụ đây. Lệnh KK rồi chọn block. Các đối tượng trong block sẽ chuyển về Layer hiện hành.

Cụ chạy ngon lành thì vui lòng bấm nút mũi tên màu xanh phía dưới bên phải của bài viết này hộ cái nhé. 

 

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer.lsp

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER=======
;===================KANGKUNG 22/03/2013===========================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq taphop(ssget))
  (setq soluong (sslength taphop))
  (setq index 0)
  (setq items (list))
  (while (< index soluong)
    (if (= (cdr (assoc 0 (setq nfo (entget (ssname taphop index))))) "INSERT")
      (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
			       (cdr (assoc 2 nfo)))
	(setq items (cons (vlax-vla-object->ename item) items))
	)
      )
    (foreach obj1 items
      (setq obj(entget obj1))
      (if (= (assoc 62 obj) nil)
	(setq Color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 obj)))))))
	(setq Color (cdr(assoc 62 obj))))
      (if (= (assoc 62 obj) nil)
	(progn
	  (setq obj(append obj (list (cons 62 Color))))
	  (entmod obj))
	(entmod (subst (cons 62 Color) (assoc 62 obj) obj))
	)
      (setq Layer (getvar "Clayer"))
      (entmod (subst (cons 8 Layer) (assoc 8 obj) obj))
      )
    (setq items (list))
    (setq index (+ index 1))
    )
  (command "UNDO" "END")
  (princ)
  )
(princ "\nNhap KK de chay chuong trinh\n")
  • Vote tăng 14

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

@KangKung : mình đọc qua code thì có mấy góp ý nhỉ sau, bạn xem có xài đc thằng nào k ^^

- Nên lọc insert trong thao tác ssget, bỏ bước kiểm tra type

- Mỗi insert thì nên lưu tên vào một list, lần sau k có trong list thì mới làm. Bạn đang làm việc thay đổi Block table, mà cứ thấy có insert lại lục tung định nghĩa block ra sửa, ắt sẽ chịu cảnh chặt chém nhiều lần

- Yêu cầu là layer thôi, k liên quan đến màu

- Nếu dùng vlax-for rồi thì chỉ cần put layer thôi, đừng chuyển về ename nữa ...

- Nếu đã chuyển về ename, mà lại thíh đổi cả màu thì cứ thế mà entmod list entget + 62 màu thôi ...

- và v...v

  • 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

@KangKung : mình đọc qua code thì có mấy góp ý nhỉ sau, bạn xem có xài đc thằng nào k ^^

- Nên lọc insert trong thao tác ssget, bỏ bước kiểm tra type

- Mỗi insert thì nên lưu tên vào một list, lần sau k có trong list thì mới làm. Bạn đang làm việc thay đổi Block table, mà cứ thấy có insert lại lục tung định nghĩa block ra sửa, ắt sẽ chịu cảnh chặt chém nhiều lần

- Yêu cầu là layer thôi, k liên quan đến màu

- Nếu dùng vlax-for rồi thì chỉ cần put layer thôi, đừng chuyển về ename nữa ...

- Nếu đã chuyển về ename, mà lại thíh đổi cả màu thì cứ thế mà entmod list entget + 62 màu thôi ...

- và v...v

Két comment chuẩn đấy. Tuy nhiên có điều này thôi: Chủ thớt không yêu cầu về màu sắc nhưng nếu block được tạo bằng các đối tượng có màu sắc khác nhau thì khi chuyển về cùng 1 layer có thể xảy ra trường hợp toàn bộ đối tượng trong block sẽ bị đổi màu về màu của layer (By Layer). Code đặt màu nhằm giữ nguyên màu sắc cho block đó.

Lisp trên mới chuyển được các đối tượng trong block đơn giản, nghĩa là block được tạo bằng các đối tượng bình thường của CAD như text, line, polyline ... còn block phức tạp bao gồm block trong block (nhiều block lồng vào nhau) thì không chuyển được. Mình đang viết code cho trường hợp đó.

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

Đổi màu thì cái gạch thứ 5 ý bạn ^^

Giả sử e là entget data. Ta sẽ có :

- Lưu trữ trạng thái màu trước khi đổi :

 

(setq m (cond ((assoc 62 e))((assoc 62 (entget (TBLOBJNAME "LAYER" (cdr (assoc 8 e))))))))

 

 Đổi layer thành "LAYER" và giữ nguyên màu :

 

(entmod (append e (list (cons 8 "LAYER") m)))

 

 Chỉ 2 dòng thế thôi mà, hoặc gộp làm một cũng đc vì khó phát sinh lỗi ^^

 

- Về nested block thì :

 + Nếu bài toán của bạn là chọn INSERT (ssget) rồi suy ngược ra Block, vậy gom tất cả cái bạn viết thành 1 hàm con rồi đệ quy nếu gặp Nested Item là  Insert thôi, mình thấy mẫu này cũng hay gặp, chỉ k biết người yêu cầu có nghĩ đến

+ Nói kỹ về yêu cầu của chủ topic, có chữ "tất cả các block" có nghĩa là toàn block trong toàn bản vẽ, có nghĩa là bạn cũng chẳng cần đệ quy gì ráo, làm vòng lặp qua toàn bộ Block Table là xong hầy

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àng mới của cụ thanhphatld đây. Đã sửa code theo góp ý của Ketxu tuy nhiên đang lằng nhằng ở đoạn block trong block nên mới chỉ sử dụng được với các block đơn giản thôi nhé.

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer_rev1.lsp

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER - REV1=======
;======================KANGKUNG 23/03/2013===============================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq soluong (sslength taphop))
  (setq index 0)
  (setq items (list))
  (while (< index soluong)
    (setq nfo (entget (ssname taphop index)))
    (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
			     (cdr (assoc 2 nfo)))
      (progn
	(setq kt 0)
	(foreach abcdef items
	  (if (eq abcdef (vlax-vla-object->ename item))
	    (setq kt 1)))
	(if (= kt 0)
	  (setq items (cons (vlax-vla-object->ename item) items)))
	))
    (setq index (+ index 1))
    )
  (foreach item items
    (if (= (vlax-get-property (vlax-ename->vla-object item) 'Color) 256)
      (setq Color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vlax-get-property (vlax-ename->vla-object item) 'Layer))))))
      (setq Color (vlax-get-property (vlax-ename->vla-object item) 'Color))
	)
    (vlax-put-property (vlax-ename->vla-object item) 'color Color)
    (vlax-put-property (vlax-ename->vla-object item) 'Layer (getvar "CLAYER"))
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  )
(princ "\nNhap KK de chay chuong trinh\n") 
  • 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

thank mấy bác nhìu nhé , ah cho mình hỏi thêm làm thế nào để tạo được 1 block mà khi đặt block đó lên block khác hay đoạn thẳng .V.V... thìphaanf nằm dưới sẽ bị che đi

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 mới chuyển toàn bộ các đối tượng trong block về cùng 1 Layer, giữ nguyên màu sắc. Block đơn giản hay phức tạp cũng chơi hết.  :D

Load lisp rồi nhập kk là xong. Không cần phải chọn đối tượng làm gì, toàn bộ block có trong bản vẽ sẽ được chuyển hết.

http://www.cadviet.com/upfiles/3/71162_chuyen_cac_doi_tuong_trong_block_ve_cung_1_layer_rev2.lsp

PS: Cụ thanhphatld muốn che đối tượng nằm dưới block thì dùng wipeout trong block là OK ngay.

;=====LISP CHUYEN CAC DOI TUONG TRONG BLOCK VE CUNG 1 LAYER - REV2=======
;======================KANGKUNG 24/03/2013===============================
(defun C:kk()
  (vl-load-com)
  (command "UNDO" "BE")
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (vlax-for item (vla-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object))) (vla-get-name for-item))
      (if (= (vlax-get-property item 'Color) 256)
	(setq color (cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vlax-get-property item 'Layer))))))
	(setq color (vlax-get-property item 'Color)))
      (vlax-put-property item 'Color color)
      (vlax-put-property item 'Layer (getvar "CLAYER"))
      )
    )
  (command "UNDO" "END")
  (princ)
  (alert "Well done!")
  )
(princ "\n                Written By KangKung\n")
(princ "\n           Nhap KK de chay chuong trinh\n")
  • 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

Hầy, sửa đi một tẹo của bạn KK. Code tường minh ở chỗ nào cần tường minh thôi ^^

(defun C:bl1(/ lay m)
	(vl-load-com)	
	(command "UNDO" "BE")
	(setq lay (getvar 'CLAYER))(setvar 'cmdecho 0)
	(vlax-for blks (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
		(vlax-for e blks 
			(vla-put-color e 
				(cond 
					((/= (setq m (vla-get-color e)) 256) m)
					((cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-Layer e))))))
				)
			)
			(vla-put-layer e lay)  
		)
	)
	(command "UNDO" "END")
(princ)
)
  • 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

thank mấy bác nhìu nhé , ah cho mình hỏi thêm làm thế nào để tạo được 1 block mà khi đặt block đó lên block khác hay đoạn thẳng .V.V... thìphaanf nằm dưới sẽ bị che đi

bạn sử dụng draw/wipeout vẽ chồng bên ngoài block đó, bạn sử dụng chức năng tìm kiếm để tìm hiểu kỹ hơn, có một topic nói về vấn đề này rồi

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

bác kang cho mình hỏi , mình chỉ muốn chuyển 1 số block được chọn trong bản vẽ thui chứ không muốn chuyển hết các block và các màu đều chuyển về by layer của block đó thì làm thế nào ? thanks bác nhìu

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

bác kang cho mình hỏi , mình chỉ muốn chuyển 1 số block được chọn trong bản vẽ thui chứ không muốn chuyển hết các block và các màu đều chuyển về by layer của block đó thì làm thế nào ? thanks bác nhìu

Không muốn chuyển hết mà chỉ muốn chuyển một số block thì bạn dùng Lisp này xem sao. 

Cách dùng: Lệnh CMB, sau đó chọn những Block cần chuyển.

;========LISP DOI MAU DOI TUONG TRONG BLOCK==========
;===============KANGKUNG 28/04/2013==================
(defun C:CMB( / i taphop lst blocklist)
  (vl-load-com)
  (command "UNDO" "BE")
  (princ "\n Chon Block can chuyen mau: ")
  (setq taphop(ssget '((0 . "INSERT"))))
  (setq i 0 lst(list))
  (while (< i (sslength taphop))
    (setq lst(append lst (list (cdr(assoc 2 (entget(ssname taphop i)))))))
    (setq i (1+ i)))
  (setq blocklist (list))
  (vlax-for for-item (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
    (if (/= (vl-position (vla-get-name for-item) lst) nil)
      (setq blocklist (append blocklist (list for-item)))
      )
    )
  (foreach block blocklist
    (vlax-for aa block
      (vla-put-color aa 256)
      )
    )
  (command "REGEN")
  (command "UNDO" "END")
  (princ)
  )
(princ "\n               KangKung - 28/04/2013\n")
(princ "\n           Nhap CMB de chay chuong trinh\n")
  • 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

Cái này không biết đúng ý bạn chưa? tớ không dùng các hàm mở rộng của Vlisp. Và có tác dụng cho cả các block lồng nhau bao nhiêu lần cũng được. Cái này chỉ cần dùng đệ quy cho các sub entity nếu kiểm tra dxf 0 là INSERT.

 

(defun c:cblay(/ ssb blist si bi Dtype i)
(prompt "\nCh\U+1ECDn \U+0111\U+1ED1i t\U+01B0\U+1EE3ng Block c\U+1EA7n chuy\U+1EC3n layer:")
(setq ssb (ssget '((0 . "INSERT"))))
(setq blist '() si 0)
(while (< si (sslength ssb))
(setq blist (append blist (list (list (cdr (assoc 2 (entget (ssname ssb si)))) (ssname ssb si)))))
(setq si (1+ si))
)
(setq Dtype '())
(while blist
(setq Dtype (append Dtype (list (car blist))))
(setq blist (vl-remove-if '(lambda (x) (= (car x) (car (car blist)))) blist))
)
(setq i 0)
(while (< i (length Dtype))
(setq bi (cadr (nth i Dtype)))
(ChangeSubLayer bi)
(setq i (1+ i))
)
(command "regen" ^C^C)
(princ)
(princ)
)
;=======================================================
(defun ChangeSubLayer (Ent / EntLst Layer Ename EntLst SubEnt SubEntLst SubLayer)
(setq EntLst (entget Ent))
(if (equal "INSERT" (cdr (assoc 0 EntLst)))
(progn
(setq Layer (cdr (assoc 8 EntLst)))
(setq Ename (tblobjname "block" (cdr (assoc 2 EntLst))))
(setq EntLst (entget Ename))
(setq SubEnt (entnext Ename))
(while SubEnt
(setq SubEntLst (entget SubEnt))
(setq SubLayer (cdr (assoc 8 SubEntLst)))
(if (/= Layer SubLayer)
(progn
(setq SubEntLst (subst (cons 8 Layer) (cons 8 SubLayer) SubEntLst))
(entmod SubEntLst)
)
)
(if (= (cdr (assoc 0 (entget SubEnt))) "INSERT")
(ChangeSubLayer SubEnt)
)
(setq SubEnt (entnext SubEnt))
)
)
)
(princ)
)
  • 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ầy, sửa đi một tẹo của bạn KK. Code tường minh ở chỗ nào cần tường minh thôi ^^

(defun C:bl1(/ lay m)
	(vl-load-com)	
	(command "UNDO" "BE")
	(setq lay (getvar 'CLAYER))(setvar 'cmdecho 0)
	(vlax-for blks (vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))
		(vlax-for e blks 
			(vla-put-color e 
				(cond 
					((/= (setq m (vla-get-color e)) 256) m)
					((cdr (assoc 62 (entget (TBLOBJNAME "LAYER" (vla-get-Layer e))))))
				)
			)
			(vla-put-layer e lay)  
		)
	)
	(command "UNDO" "END")
(princ)
)

 

@ketxu chỉnh giúp mình thành chọn từng block nhé! Thanks.

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

đúng rồi bác ketxu và bác KangKung ơi, thế này khó kiểm soát lắm, các bác chỉnh lại là chọn block rồi mới thi hành lệnh đi. còn nếu muốn thi hành cho tất cả block thì fi cũng đc mà :)

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 của bác Ketxu tinh gọn hay quá :) ! Nhưng khổ nổi nó chạy đờ rét không cho chọn Block gì hết ^_^ ...Nhờ bác chỉnh cho chọn Block với ạ. Thanks!

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

thank b nhiều nha! bạn sữa giúp mình chút, cho mau của các đối tượng dề theo by layer dc ko bạn?

Bạn thử cái này, tôi cũng chưa test nhiều, bạn test trên block lồng nhau xem sao.

 

(defun c:Geb( / v)
  (defun geb(v lay / name en)
    (setq name (cdr (assoc 2 (entget v))))
    (if (setq en (tblobjname "BLOCK" name))
  (while (setq en (entnext en))
 (setq eg (entget en))
 (if (/= "INSERT" (cdr (assoc 0 eg)))
   (progn
     (entmod (subst (cons 8 lay) (assoc 8 eg) eg))
     (entmod (cons (cons 62 256) (vl-remove (assoc 62 eg) eg))))
   (geb en lay))))
  )   
  (geb (setq v (car (entsel "\nChon block:")))
       (cdr (assoc 8 (entget v))))
  (princ)
)

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

http://www.cadviet.com/upfiles/6/89470_norm.lsphttp://www.cadviet.com/upfiles/6/89470_norm_1.lsptrong bản vẽ của mình có rất nhiều block , mình muốn chuyển tất cả các đối tượng trong tất cả các block về cùng 1 layer thì làm thế nào mong các bác giúp em với, chỉ thực hiện 1 lệnh thui chứ làm từng cái thì lâu quá

Mình thấy yêu cầu của bạn gần giống với tính chát công việc của mình, thông thường thì ben mình thiết điện, mình nhận được bản vẽ kiến trúc, rồi sau đó dọn dẹp bản vẽ,  xóa hết các dim va các thứ lung tung, rôi sau đó chuyển tất cả nền kiến trúc về layer 0, và màu số 8. Trong đó, nên kiến trúc có rất nhiều các đối tượng block trùng nhau, mà edit chỉnh màu mè từng cái thì rất lâu, nên mình tìm được cái lisp norm.lsp , bạn chỉ cần gõ lệnh norm, enter chờ máy chạy, rùi sau đó bạn chọn hết cac đối tượng, chọn layer0, màu số 8 là ok. minh đã dùng trên bản vẽ của mình thấy ok. Link mình tìm thấy nó đây: http://www.cadtutor.net/forum/showthread.php?19161-lisp-for-changing-all-objects-in-a-block-to-layer-quot-0-quot

P/s: vì các công cụ lisp ở trên mình đã dùng mà ko thể chuyển được block lồng nhau.

 

Lisp: norm.lsp

Link: https://drive.google.com/open?id=0B4fKWatut_ZnNmxON3BsQ1lGUEE

Chỉnh sửa theo vinh06102vt

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


×