Nhờ các cao thủ viết hộ Lisp copy với nội dung bên dưới

[hoangtdh 8]

Gửi bạn Tuyến,

Lisp này của bạn khi chạy mà chọn block thì layer trong block đổi thành layer hiện hành còn layer ngoài vẫn giữ layer cũ.

Mình copy code cl.lsp cũ của bạn và paste thêm vào cl2.lsp và đổi tên lệnh thành cl1. Dùng phối hợp cl và cl1 thì đạt được kết quả đề ra là cả layer trong và ngoài block đều thuộc layer hiện hành.

Bạn có thể gộp 2 đoạn code này thành 1 và dùng chung tên lệnh là cl được không.

Cám ơn bạn nhiều.

Hoàng

[nguyentuyen6 130]

Gửi bạn Tuyến,

Lisp này của bạn khi chạy mà chọn block thì layer trong block đổi thành layer hiện hành còn layer ngoài vẫn giữ layer cũ.

Mình copy code cl.lsp cũ của bạn và paste thêm vào cl2.lsp và đổi tên lệnh thành cl1. Dùng phối hợp cl và cl1 thì đạt được kết quả đề ra là cả layer trong và ngoài block đều thuộc layer hiện hành.

Bạn có thể gộp 2 đoạn code này thành 1 và dùng chung tên lệnh là cl được không.

Cám ơn bạn nhiều.

Hoàng

Của bạn đây:

 

http://www.cadviet.com/upfiles/3/cl_3.lsp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
				;nguyentuyen6 @ Cadviet 
(defun c:cl (/ ss en el i curla)
 (setvar "cmdecho" 0)
 (command ".UNDO" "E")
 (princ "\nChon doi tuong chuyen ve layer hien hanh :")
 (setq curla (getvar "clayer"))
 (setq ss (ssget))
;;;;;;;; 
   (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
(if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
(if	(= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
       (moddxf 8 curla en)
       (upwblock en)
	)
)
   (entupd en)
   (setq i (1+ i))
 )					; (command ".REGEN")  
 (command ".UNDO" "E")
 (setvar "cmdecho" 1)
 (princ "\n....DONE....")
 (princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun upwblock	(blk / s en els el)
 (setq s (cdr (assoc 2 (entget blk))))
 (setq en (cdr (assoc -2 (tblsearch "BLOCK" s))))
 (while en
   (setq els (entget en))
   (if	(wcmatch (cdr (assoc 0 els)) "INSERT")
     (upwblock en)
     (progn (if (/= (cdr (assoc 8 (entget en))) curla)
       (moddxf 8 curla en)
     )
     )
   )
   (entupd en)
   (setq en (entnext en))
 )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

[hoangtdh 8]

Gửi bạn nguyentuyen6,

Chuẩn ko cần chỉnh, cám ơn bạn nhiều.

Hoàng