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ờ viết lisp dọn mặt bằng siêu tốc

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

Bạn muốn đổi tất cả về 1 màu, không đổi layer, hay chuyển hết về 1 màu, 1 layer, nhưng không xóa các layer thừa (purge) đ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ạn muốn đổi tất cả về 1 màu, không đổi layer, hay chuyển hết về 1 màu, 1 layer, nhưng không xóa các layer thừa (purge) đi ?

em muốn đổi tất cả về màu 8 mà vẫn giữ nguyên layer và xóa các layer ko dùng đến đ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ạn dùng IE để down lisp nhé. Nếu không thì reply, copy code của mình rồi tạo file lisp hoặc paste thẳng vào commandline của CAD ^^

 

(defun c:clear()
;free lisp from CADviet.com
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(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

Bạn dùng IE để down lisp nhé. Nếu không thì reply, copy code của mình rồi tạo file lisp hoặc paste thẳng vào commandline của CAD ^^

 

(defun c:clear()
;free lisp from CADviet.com
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(princ))

lisp của bác chạy rất tốt.đã chuyển tất kả về màu 8 nhưng khi e bật layer lên thì màu trong đó vẫn giữ nguyên màu như lúc đầu.Bác xem lai giúp em nhe'

Thank bac :rolleyes:

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 chạy rất tốt.đã chuyển tất kả về màu 8 nhưng khi e bật layer lên thì màu trong đó vẫn giữ nguyên màu như lúc đầu.Em muốn tất cả màu ở trong layer cũng tự động chuyển về màu 8.Bác xem lai giúp em nhe'

Thank bac :rolleyes:

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ạn chỉ yêu cầu chuyển tất cả về màu 8 chứ chưa yêu cầu chuyển màu của layer về màu 8, phải không nào ^^ Bạn gửi lại file giúp mình nhé.

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ạn chỉ yêu cầu chuyển tất cả về màu 8 chứ chưa yêu cầu chuyển màu của layer về màu 8, phải không nào ^^ Bạn gửi lại file giúp mình nhé.

http://www.cadviet.com/upfiles/3/img_drawings_option_1_rev_no02_jan_27_2011.dwg

tất cả về hết màu 8,trong layer cung về hết màu 8,tất cả các đường về cỡ 0.09.

Bác xem dồi sủa code cho em nhe'.

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ạn chỉ thêm 1 dòng trong code là được. Bạn chịu khó copy code nhé, tối rùi, mình hơi lười upload ^^

(defun c:clear1()
;free lisp from CADviet.com @ketxu
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")
(command "-layer" "c" "8" "*" "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(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

Bạn thêm 1 dòng thôi là được. Tối r mình ngại upload quá, bạn chịu khó chép code nhé

 

(defun c:clear1()
;free lisp from CADviet.com @ketxu
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")
(command "-layer" "c" "8" "*" "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(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

Bạn thêm 1 dòng thôi là được. Tối r mình ngại upload quá, bạn chịu khó chép code nhé

 

(defun c:clear1()
;free lisp from CADviet.com @ketxu
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")
(command "-layer" "c" "8" "*" "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(princ))

chuẩn không cần chỉnh.

thank bác nhiề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

Nhiều khi nhìn kết quả thì có vẻ chuẩn, nhưng code thì vẫn đau đáu ngồi edit ^^ Nhìn nó rườm rà là cực kỳ ức..

ANW,CHúc bạn vui!

P/s : cứ nhấn Thanks tớ là được 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ạn thêm 1 dòng thôi là được. Tối r mình ngại upload quá, bạn chịu khó chép code nhé

 

(defun c:clear1()
;free lisp from CADviet.com @ketxu
(vl-load-com)
(command "undo" "be")
(command "change" (ssget "X") "" "p" "c" "8" "")
(if (ssget "x" '((0 . "INSERT")(66 . 1)))
 (progn
	(setq adoc (vla-get-activedocument (vlax-get-acad-object))
		  ss (vla-get-activeselectionset adoc)
	)
    (vlax-for block (vla-get-blocks adoc)	
		(if (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
			(vlax-for   ent block 
				(progn			
				(vla-put-color ent "8")					
				)    
			) 
		) 
	)
	(vlax-for attblock ss
		(setq atts (vlax-invoke attblock 'getattributes))
		(foreach att atts
			(vla-put-color att 8)				
		)
	)   
  );end progn
 );end if
(acet-sysvar-set (list "dimclrt" 8 "dimclre" 8 "dimclrd" 8 "cmdecho" 0 "INSUNITS" 4 "INSUNITSDEFSOURCE" 4 "INSUNITSDEFTARGET" 4)) 
(command "dim1" "update" (ssget "X" '((0 . "Leader"))) "")
(command "-layer" "c" "8" "*" "")	
(vla-regen adoc acactiveviewport) 
(command "-purge" "a" "" "N")
(command "undo" "e") 
(princ))

 

Bác cho thêm yêu cầu tất kả các đường trong layer về cỡ 0.09 cho e nhé trong lisp clear1.

Nó sẽ giúp ích cho em rất nhiều trong công việc.

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ó lẽ là bạn quá lười rồi ^^. Hơn nữa, khi chưa test xong xuôi thì bạn đừng kết luận "chuẩn k cần chỉnh", để rồi bây giờ mình lại ngồi chỉnh đây.

Bạn thêm dòng này :

(command "-layer" "LW" 0.09 "*" "")

vào sau dòng :

(command "-layer" "c" "8" "*" "")

 

Hoặc sửa dòng

(command "-layer" "c" "8" "*" "") thành (command "-layer" "c" "8" "*" "LW" 0.09 "*" "")

Hy vọng bạn có thể sửa được ^^

  • 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


×