Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
7 replies to this topic

#1 txquychk51

txquychk51

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 04 October 2016 - 08:07 AM

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...ah/Drawing2.dwg


  • -1

#2 Bee

Bee

    biết lệnh extend

  • Members
  • PipPipPip
  • 198 Bài viết
Điểm đánh giá: 68 (tàm tạm)

Đã gửi 04 October 2016 - 08:02 PM

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

  • 1

#3 txquychk51

txquychk51

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 04 October 2016 - 08:05 PM

 

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ử


  • 0

#4 txquychk51

txquychk51

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 04 October 2016 - 08:23 PM

không được bác ah, cad nó báo Command: test
; error: ActiveX Server returned the error: unknown name: Name
Command:
  • 0

#5 txquychk51

txquychk51

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 04 October 2016 - 08:30 PM

e ko up trực tiếp lên diễn đàn được nên e up lên media ạ
http://www.mediafire...ah/Drawing2.dwg


  • 0

#6 Bee

Bee

    biết lệnh extend

  • Members
  • PipPipPip
  • 198 Bài viết
Điểm đánh giá: 68 (tàm tạm)

Đã gửi 04 October 2016 - 09:07 PM

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

  • 1

#7 txquychk51

txquychk51

    biết vẽ ellipse

  • Members
  • PipPip
  • 58 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 04 October 2016 - 09:43 PM

e đã thử và tuyệt cú mèo luôn bác ơi. cảm ơn bác nhé. :)


  • 1

#8 Bee

Bee

    biết lệnh extend

  • Members
  • PipPipPip
  • 198 Bài viết
Điểm đánh giá: 68 (tàm tạm)

Đã gửi 04 October 2016 - 11:06 PM

Không có ji ^_^
  • 0