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

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

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

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

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

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

  • 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

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


×