Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
nguyennhulinh

Nhờ viết lisp đổi màu về bylayer

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

E có bản vẽ các layer bị đổi màu lung tung, giờ muốn nhờ các bác viết giúp e lisp khi mình chọn vào đối tượng thì nó sẽ tự động chuyển về bylayer.Không phải đổi thủ công trên thanh công cụ.

E tìm đc cái lisp này trên mạng mà ko hiểu sai ở đâu.Bác nào cao thủ lisp giúp e với.

(defun C:CBL (/ gp) (setq gp (ssget)) (command "change" gp "" "p" "c" "l" "" ));màu theo lop - by Layer

(defun C:CBB (/ gp) (setq gp (ssget)) (command "change" gp "" "p" "c" "b" "" ));màu theo khoi - by Block

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

Chuyển về Bylayer các đối tượng chọn theo ý tưởng của bạn thì :

;; free lisp from cadviet.com @ssg

;;;-------------------------------------------------------------------------------
(defun remc(s / sn i OK sc ch) ;;;Remove color code
(setq sn "" i 1 OK T)
(repeat (strlen s)
  (setq
       sc (substr s i 2)
       ch (substr s i 1)
  )
  (if (= sc "\\C") (setq OK nil))
  (if OK
      (setq sn (strcat sn ch))
      (if (= ch ";") (setq OK T)) 
   )
   (setq i (1+ i))
)
sn
)
;;;-------------------------------------------------------------------------------
(defun C:CBL(/ ss e d old new) ;;;Reset all objects ByLayer
(setq ss (ssget "X" '((0 . "MTEXT"))))
(while (setq e (ssname ss 0))
   (setq
       d (entget e)
       old (assoc 1 d)
       new (cons 1 (remc (cdr old)))
       d (subst new old d)
  )
  (entmod d)
  (ssdel e ss)
)
(command "change" (ssget "X") "" "p" "C" "bylayer" "LT" "bylayer" "LW" "bylayer" "")
(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
Chuyển về Bylayer các đối tượng chọn theo ý tưởng của bạn thì :

;; free lisp from cadviet.com @ssg

;;;-------------------------------------------------------------------------------
(defun remc(s / sn i OK sc ch) ;;;Remove color code
(setq sn "" i 1 OK T)
(repeat (strlen s)
  (setq
       sc (substr s i 2)
       ch (substr s i 1)
  )
  (if (= sc "\\C") (setq OK nil))
  (if OK
      (setq sn (strcat sn ch))
      (if (= ch ";") (setq OK T)) 
   )
   (setq i (1+ i))
)
sn
)
;;;-------------------------------------------------------------------------------
(defun C:CBL(/ ss e d old new) ;;;Reset all objects ByLayer
(setq ss (ssget "X" '((0 . "MTEXT"))))
(while (setq e (ssname ss 0))
   (setq
       d (entget e)
       old (assoc 1 d)
       new (cons 1 (remc (cdr old)))
       d (subst new old d)
  )
  (entmod d)
  (ssdel e ss)
)
(command "change" (ssget "X") "" "p" "C" "bylayer" "LT" "bylayer" "LW" "bylayer" "")
(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

remc là hàm con,không phải là lệnh.Trên diễn đàn thì lệnh của file lisp thường được hiện lên bên trên tên file luôn :D

Nếu dùng cbl mà lỗi thì bạn post lỗi lên mình xem sao :D

Mí lị bạn dùng CBL nào, trên hay dướ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
remc là hàm con,không phải là lệnh.Trên diễn đàn thì lệnh của file lisp thường được hiện lên bên trên tên file luôn :D

Nếu dùng cbl mà lỗi thì bạn post lỗi lên mình xem sao :D

Mí lị bạn dùng CBL nào, trên hay dưới ^^

Lỗi này chắc do trong bản vẽ không có MTEXT nào -> dẫn đến lỗi

=> Nên kiểm tra tập ss có chứa anh MTEXT nào hay không?

=> Nếu tập chọn ss có chứa MTEXT mới thực thi code tiếp theo

Bạn Nguyennhulinh sử dụng code này nhé

Lệnh là CBL

(defun remc(s / sn i OK sc ch) ;;;Remove color code
(setq sn "" i 1 OK T)
(repeat (strlen s)
  (setq
       sc (substr s i 2)
       ch (substr s i 1)
  )
  (if (= sc "\\C") (setq OK nil))
  (if OK
      (setq sn (strcat sn ch))
      (if (= ch ";") (setq OK T)) 
   )
   (setq i (1+ i))
)
sn
)
;;;-------------------------------------------------------------------------------
(defun C:CBL(/ ss e d old new) ;;;Reset all objects ByLayer
(if(setq ss (ssget "X" '((0 . "MTEXT"))))
(while (setq e (ssname ss 0))
   (setq
       d (entget e)
       old (assoc 1 d)
       new (cons 1 (remc (cdr old)))
       d (subst new old d)
  )
  (entmod d)
  (ssdel e ss)
)
)
(command "change" (ssget "X") "" "p" "C" "bylayer" "LT" "bylayer" "LW" "bylayer" "")

(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

Trước mình cũng viết cái Líp này mà dài loàng ngoằng ra. hehe

 

(defun moddxf (dxf chdxf ss)
 (entmod
   (subst (cons dxf chdxf) (assoc dxf (entget ss)) (entget ss))
 )
)
(vl-load-com)
(defun c:bylayer (/ ss en el i)
 (vl-load-com)
(setvar "cmdecho" 0)  
(command ".UNDO" "E") 
 (princ "\n >>> Dang xu ly .....")
 (princ "\nChuyen ve ByLayer")
 ;25/11/2010
 ;nguyentuyen86@gmail.com
 (setq ss (ssget "x"))
 (setq i 0)
 (while (< i (sslength ss))
   (setq en (ssname ss i))
   (if	(/= (cdr (assoc 0 (entget en))) "INSERT")
     (progn
(if (/= (cdr (assoc 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)
     )
     (upwblock en)
   )
(entupd en)
   (setq i (1+ i))
 )
(command ".REGEN")
(command ".UNDO" "E")
(setvar "cmdecho" 0)  
(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 62 (entget en))) nil)
  (moddxf 62 256 en)
)
(setq el (vlax-ename->vla-object en))
(vlax-put-property el 'Linetype "ByLayer")
(vlax-put-property el 'Lineweight -1)

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

Come on!

 

Nhờ các bác viết dùm em đoạn lisp chuyển đặc tính (chỉ riêng) đối tượng được chọn về Bylayer!

Thack all!!!!!!!!!

Hề hề hề,

Đặc tình chi hè??? Gì chứ cái đặc tình Autotay là thua luôn đấy.....

Hề hề hề,....

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

Come on!

 

Nhờ các bác viết dùm em đoạn lisp chuyển đặc tính (chỉ riêng) đối tượng được chọn về Bylayer!

Thack all!!!!!!!!!

 

đoạn đấy đây :D lệnh là 0

 

(defun c:0 () (ssget) (command  "change"  "p" "" "p" "c" "bylayer" ""))

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

Đăng nhập để thực hiện theo  

×