Đến nội dung


Hình ảnh

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


  • Please log in to reply
20 replies to this topic

#1 thanhphatld

thanhphatld

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 22 March 2013 - 08:36 PM

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á


  • 1

#2 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 22 March 2013 - 11:01 PM

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.c...ung_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")

  • 13

#3 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 March 2013 - 12:58 AM

@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
  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#4 LoveLisp

LoveLisp

    biết lệnh extend

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

Đã gửi 23 March 2013 - 08:21 AM

Các góp ý rất hay, nếu được áp dụng nó sẽ giảm đáng kể thời gian thực thi.


  • 0

#5 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 23 March 2013 - 03:19 PM

@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 đó.


  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 23 March 2013 - 09:24 PM

Đổ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


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 23 March 2013 - 11:31 PM

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.c..._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") 

  • 2

#8 thanhphatld

thanhphatld

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 March 2013 - 01:39 PM

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


  • 0

#9 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 24 March 2013 - 03:30 PM

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.c..._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")

  • 5

#10 thanhphatld

thanhphatld

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 March 2013 - 04:25 PM

thank bác Kang nhìu lém, zậy mà em mò mãi không ra


  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5679 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 24 March 2013 - 04:53 PM

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

  • 2

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 thanhlam13388

thanhlam13388

    biết vẽ polygon

  • Members
  • PipPip
  • 76 Bài viết
Điểm đánh giá: 22 (tàm tạm)

Đã gửi 24 March 2013 - 09:28 PM

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


  • 0
Hình đã gửiKhông sợ khó , chỉ sợ khô!
Không sợ khổ, chỉ sợ mềm!

#13 thanhphatld

thanhphatld

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 April 2013 - 03:18 PM

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
  • 0

#14 KangKung

KangKung

    biết lệnh array

  • Members
  • PipPipPip
  • 189 Bài viết
Điểm đánh giá: 227 (khá)

Đã gửi 28 April 2013 - 12:14 PM

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

  • 2

#15 thehost31

thehost31

    biết vẽ line

  • Members
  • PipPip
  • 26 Bài viết
Điểm đánh giá: 17 (tàm tạm)

Đã gửi 28 April 2013 - 01:12 PM

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


  • 1

#16 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 21 February 2014 - 02:05 PM

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.


  • 0

#17 engineer2017

engineer2017

    Chưa sử dụng CAD

  • Members
  • Pip
  • 3 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 July 2014 - 02:29 PM

đú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à :)


  • 0

#18 phamhung12

phamhung12

    biết vẽ ellipse

  • Members
  • PipPip
  • 59 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 14 July 2014 - 01:19 PM

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!


  • 0

#19 Ngocnguyenn

Ngocnguyenn

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 07 October 2014 - 08:16 PM

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?


  • 0

#20 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 09 October 2014 - 09:09 AM

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

  • 0