Chuyển đến nội dung
Diễn đàn CADViet
txquychk51

Nhờ Viết Lisp Chuyển Layer Cho Leader Và Text

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

e up load bản vẽ của e lên ạ. mong mọi người viết giúp e 1 lisp mà khi mình sử dụng thì: 

1. leader hình mũi tên(closed filled) sẽ chuyển hết về layer "14.Dimhh"; 

2. leader hình tròn (Dot blank) sẽ chuyển hết về layer "15.Dimct". 

3. các text thuộc text style "Text 1.5" và "Text 1.8" sẽ chuyển về layer "06.Text1.8"; 

4. text thuộc text style "Text 2.5" và "Text 3.0" sẽ chuyển về layer "07.Text3.0". 

các layer và các style đã có sẵn trong bản vẽ, nhưng e ko up bản vẽ lên được (cứ báo Đang upload. Xin chờ). e cảm ơn ạ

 

http://www.mediafire.com/file/1949oe06472a3ah/Drawing2.dwg

  • Vote giảm 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

e up load bản vẽ của e lên ạ. mong mọi người viết giúp e 1 lisp mà khi mình sử dụng thì: 

1. leader hình mũi tên(closed filled) sẽ chuyển hết về layer "14.Dimhh"; 

2. leader hình tròn (Dot blank) sẽ chuyển hết về layer "15.Dimct". 

3. các text thuộc text style "Text 1.5" và "Text 1.8" sẽ chuyển về layer "06.Text1.8"; 

4. text thuộc text style "Text 2.5" và "Text 3.0" sẽ chuyển về layer "07.Text3.0". 

các layer và các style đã có sẵn trong bản vẽ, nhưng e ko up bản vẽ lên được (cứ báo Đang upload. Xin chờ). e cảm ơn ạ

Uhm, thử lisp này xem ^_^

(defun c:test ()
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blks (vla-get-blocks acdoc)
    (vlax-for obj blks
      (if (wcmatch (vla-get-ObjectName obj) "AcDbLeader")
	(progn
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "")
	    (vla-put-Layer obj "14.Dimhh")
	    )
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "DotBlank")
	    (vla-put-Layer obj "15.Dimct")
	    )
	  )
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 1.5")
		   (wcmatch (vla-get-StyleName obj) "Text 1.8")
		   )
	       )
	(vla-put-Layer obj "06.Text1.8")
	)
      (if (and (wcmatch (vla-get-Name obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 2.5")
		   (wcmatch (vla-get-StyleName obj) "Text 3.0")
		   )
	       )
	(vla-put-Layer obj "07.Text3.0")
	)
      );vlax-for obj
    );vlax-for blks
  (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

 

Uhm, thử lisp này xem ^_^

(defun c:test ()
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blks (vla-get-blocks acdoc)
    (vlax-for obj blks
      (if (wcmatch (vla-get-ObjectName obj) "AcDbLeader")
	(progn
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "")
	    (vla-put-Layer obj "14.Dimhh")
	    )
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "DotBlank")
	    (vla-put-Layer obj "15.Dimct")
	    )
	  )
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 1.5")
		   (wcmatch (vla-get-StyleName obj) "Text 1.8")
		   )
	       )
	(vla-put-Layer obj "06.Text1.8")
	)
      (if (and (wcmatch (vla-get-Name obj) "*TEXT")
	       (or (wcmatch (vla-get-StyleName obj) "Text 2.5")
		   (wcmatch (vla-get-StyleName obj) "Text 3.0")
		   )
	       )
	(vla-put-Layer obj "07.Text3.0")
	)
      );vlax-for obj
    );vlax-for blks
  (princ)
  )

ôi e chờ mãi. cám ơn bác trước ạ, giờ e thử

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

không được bác ah, cad nó báo Command: test

; error: ActiveX Server returned the error: unknown name: Name

Command:

Thay "*TEXT" trong code bằng "AcDbText" là ngon. ^_^

(defun c:test ()
  (setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blks (vla-get-blocks acdoc)
    (vlax-for obj blks
      (if (wcmatch (vla-get-ObjectName obj) "AcDbLeader")
	(progn
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "")
	    (vla-put-Layer obj "14.Dimhh")
	    )
	  (if (wcmatch (vla-get-ArrowheadBlock obj) "DotBlank")
	    (vla-put-Layer obj "15.Dimct")
	    )
	  )
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "AcDbText")
	       (or (wcmatch (vla-get-StyleName obj) "Text 1.5")
		   (wcmatch (vla-get-StyleName obj) "Text 1.8")
		   )
	       )
	(vla-put-Layer obj "06.Text1.8")
	)
      (if (and (wcmatch (vla-get-ObjectName obj) "AcDbText")
	       (or (wcmatch (vla-get-StyleName obj) "Text 2.5")
		   (wcmatch (vla-get-StyleName obj) "Text 3.0")
		   )
	       )
	(vla-put-Layer obj "07.Text3.0")
	)
      );vlax-for obj
    );vlax-for blks
  (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

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


×