Đến nội dung


Hình ảnh

[Nhờ chỉnh sửa] lisp xoay text theo pline


  • Please log in to reply
76 replies to this topic

#1 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 10:13 AM

Mình tìm trên diễn đàn thấy có lsp xoay text song song với 1 đối tượng khác (là góc nhập vào hoặc 1 đoạn thẳng cho trước).

Nhờ các anh trên diễn đàn chỉnh sửa với yêu cầu: Xoay text chọn theo đường pl cho trước (đường pl này gồm nhiều đoạn gãy khúc). Các text nằm gần đoạn nào sẽ được xoay song song với đoạn thẳng đó (có file mẫu đính kèm) http://www.cadviet.c..._file_mau_3.dwg.

Rất mong các anh ra tay giúp đỡ.

 

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...doi-tuong-khac/
(defun c:Rot(/ chon goc ts dem ten ) ;--------------Text rotate -----------------------
 
(prompt "\nChon doi tuong can quay: ")
 
(setq chon (ssget))
 
(if (= t (null chon)) (prompt "Ban chua chon doi tuong nao. Lenh ket thuc.")
 
(progn
 
(if (null goc) (setq goc 0)) 
 
(prompt "Nhap goc quay doi tuong [Nhap hai diem de xac dinh goc] ") 
 
(princ "<")(princ (angtos goc)) (princ ">: ")
 
(setq goc (getangle))
 
(setq ts (sslength chon))
 
(setq dem 0)
 
(while (< dem ts)
 
(progn
 
(setq ten (entget (ssname chon dem)))
 
(setq ten (subst (cons 50 goc) (assoc 50 ten) ten )) 
 
(entmod ten)
 
(setq dem (+ 1 dem))
 
)
 
)
 
)
 
)
 
(princ) 
 
)
 

  • 0

#2 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 25 February 2013 - 11:14 AM

Bạn vui lòng cho code vào tag CODE


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#3 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 11:48 AM

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/8335-xoay-mot-doi-tuong-song-song-voi-1-doi-tuong-khac/
(defun c:Rot(/ chon goc ts dem ten ) ;--------------Text rotate -----------------------

(prompt "\nChon doi tuong can quay: ")

(setq chon (ssget))

(if (= t (null chon)) (prompt "Ban chua chon doi tuong nao. Lenh ket thuc.")

(progn

(if (null goc) (setq goc 0))

(prompt "Nhap goc quay doi tuong [Nhap hai diem de xac dinh goc] ")

(princ "<")(princ (angtos goc)) (princ ">: ")

(setq goc (getangle))

(setq ts (sslength chon))

(setq dem 0)

(while (< dem ts)

(progn

(setq ten (entget (ssname chon dem)))

(setq ten (subst (cons 50 goc) (assoc 50 ten) ten ))

(entmod ten)

(setq dem (+ 1 dem))

)

)

)

)

(princ)

)


  • 0

#4 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 11:51 AM

Lần đầu Khaosatheco lập Topic có gì xin các bác chỉ giáo.


  • 0

#5 Chiron

Chiron

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 90 (tàm tạm)

Đã gửi 25 February 2013 - 12:03 PM

Ý Ketxu là khaosatheco hãy sửa lại bài #1, cho code vào tag code.


  • 0

#6 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 12:13 PM

Mình tìm trên diễn đàn thấy có lsp xoay text song song với 1 đối tượng khác (là góc nhập vào hoặc 1 đoạn thẳng cho trước).


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/8335-xoay-mot-doi-tuong-song-song-voi-1-doi-tuong-khac/
(defun c:Rot(/ chon goc ts dem ten ) ;--------------Text rotate -----------------------

(prompt "\nChon doi tuong can quay: ")

(setq chon (ssget))

(if (= t (null chon)) (prompt "Ban chua chon doi tuong nao. Lenh ket thuc.")

(progn

(if (null goc) (setq goc 0)) 

(prompt "Nhap goc quay doi tuong [Nhap hai diem de xac dinh goc] ") 

(princ "<")(princ (angtos goc)) (princ ">: ")

(setq goc (getangle))

(setq ts (sslength chon))

(setq dem 0)

(while (< dem ts)

(progn

(setq ten (entget (ssname chon dem)))

(setq ten (subst (cons 50 goc) (assoc 50 ten) ten )) 

(entmod ten)

(setq dem (+ 1 dem))

)

)

)

)

(princ) 

)
 

 

Nhờ các anh trên diễn đàn chỉnh sửa với yêu cầu: Xoay text chọn theo đường pl cho trước (đường pl này gồm nhiều đoạn gãy khúc). Các text nằm gần đoạn nào sẽ được xoay song song với đoạn thẳng đó (có file mẫu đính kèm) http://www.cadviet.c..._file_mau_3.dwg.

Rất mong các anh ra tay giúp đỡ.


  • 0

#7 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 25 February 2013 - 02:09 PM

Mình tìm trên diễn đàn thấy có lsp xoay text song song với 1 đối tượng khác (là góc nhập vào hoặc 1 đoạn thẳng cho trước).

 

Nhờ các anh trên diễn đàn chỉnh sửa với yêu cầu: Xoay text chọn theo đường pl cho trước (đường pl này gồm nhiều đoạn gãy khúc). Các text nằm gần đoạn nào sẽ được xoay song song với đoạn thẳng đó (có file mẫu đính kèm) http://www.cadviet.c..._file_mau_3.dwg.

Rất mong các anh ra tay giúp đỡ.

Hề hề hề,

Yếu cầu của bạn xem ra không quá khó. Song rất tiếc là hình như trang download của diễn đàn có vấn đề nên mình không thể down bản vẽ về để xem cụ thể được. Nếu bạn thật cần, có thể gửi file bản vẽ qua trang khác để mình down về hoặc gửi qua mail cho mình, mình sẽ thử xem sao.

Hề hề hề,...


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#8 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 03:14 PM

Hề hề hề,

Yếu cầu của bạn xem ra không quá khó. Song rất tiếc là hình như trang download của diễn đàn có vấn đề nên mình không thể down bản vẽ về để xem cụ thể được. Nếu bạn thật cần, có thể gửi file bản vẽ qua trang khác để mình down về hoặc gửi qua mail cho mình, mình sẽ thử xem sao.

Hề hề hề,...

Gửi anh Bình. Đây là file bản vẽ nhờ anh giúp đỡ.

http://www.fshare.vn/file/WO9WRY2Z77/


  • 0

#9 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 25 February 2013 - 04:41 PM

Gửi anh Bình. Đây là file bản vẽ nhờ anh giúp đỡ.

http://www.fshare.vn/file/WO9WRY2Z77/

Hề hề hề,

Bạn dùng thử cái này coi sao nhé.

 

 

defun c:xotxt (/ oldos sst pl obj p0 par pa1 pa2 goc etxt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "Chon tap hop text can xoay")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq pl (car (entsel "\n Chon polyline dinh huong")))
(setq obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (vlax-curve-getclosestpointto obj (cdr (assoc 11(setq etxt (entget txt)))) nil)
         par (vlax-curve-getparamatpoint obj p0)
         pa1 (vlax-curve-getpointatparam obj (fix par))
         pa2 (vlax-curve-getpointatparam obj (1+ (fix par)))
         goc (angle pa1 pa2)
)
(setq etxt (subst (cons 50 goc) (assoc 50 etxt) etxt))
(entmod etxt)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
     

Chúc bạn vui.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#10 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 25 February 2013 - 04:56 PM

Khi ap thì bị lỗi này bác Bình ơi

Command: error: bad argument type: numberp: nil


  • 0

#11 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 25 February 2013 - 10:44 PM

Quick code cho bạn :

(defun c:tor(/ ob)(vl-load-com)
    ;Xoay text theo 1 duong dan
    ;Ketxu quick code 25/2
    (cond 
        ((and
            (setq ob (entsel "\n\U+0110\U+1ED1i t\U+01B0\U+1EE3ng d\U+1EABn : "))
            (ssget (list (cons 0 "TEXT,MTEXT")))
        )
        (setq ob (car ob))
        (vlax-for obT (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object)))
            (vla-put-Rotation 
                obT
                ((lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
                (+ (* 0.5 pi)
                (angle     (setq a (vlax-get obT 'InsertionPoint))
                        (vlax-curve-getclosestpointto ob a T)
                )))
            )
        ))
        (T (alert "L\U+1ED7i thao t\U+00E1c!"))
    )
    (princ)
)

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#12 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 26 February 2013 - 08:19 AM

Tuyệt vời. Cảm ơn Ketxu.


  • 0

#13 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 26 February 2013 - 08:30 AM

Ơ ơ.. Ketxu ơi. Trong bản vẽ mẫu là vẽ pl từ trái qua phải -> ok. Nhờ anh bổ sung thêm nếu vẽ pl từ phải qua trái thì text xoay song song với pl theo hướng vẽ pl. 


  • 0

#14 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5682 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 26 February 2013 - 08:45 AM

@OP : mình viết theo kiểu bạn vẽ PL đi đâu cũng được, tiêu chí cuối cùng là nó quay tẽxt // với segment nhưng theo hướng người đọc có thể đọc được. Nếu xoay theo chiều vẽ pline  tẽxt có thể bị lộn lại. Bạn vui lòng liệt kê các trường hợp trong file vẽ, vì dạo này ket rất lười code ^^


  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#15 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 February 2013 - 09:26 AM

Khi ap thì bị lỗi này bác Bình ơi

Command: error: bad argument type: numberp: nil

Hề hề hề,

Lỗi là do trong đám text của bạn tồn tại một hay vài text mà lisp không tìm được điểm gần nhất trên polyline. Vì thế nên nó chả biết đường nào để xoay cả. Để tránh lỗi này bạn có thể kiểm tra sơ bộ trước khả năng có các tẽt này và tiến hành xoay từng cụm text một bạn ạ.

Việc sửa lisp mình sẽ nghiuên cứu và bổ sung sau.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#16 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 26 February 2013 - 09:41 AM

@OP : mình viết theo kiểu bạn vẽ PL đi đâu cũng được, tiêu chí cuối cùng là nó quay tẽxt // với segment nhưng theo hướng người đọc có thể đọc được. Nếu xoay theo chiều vẽ pline  tẽxt có thể bị lộn lại. Bạn vui lòng liệt kê các trường hợp trong file vẽ, vì dạo này ket rất lười code ^^

Nhờ anh Ketxu xem giúp.

 


  • 0

#17 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 February 2013 - 11:22 AM

Ơ ơ.. Ketxu ơi. Trong bản vẽ mẫu là vẽ pl từ trái qua phải -> ok. Nhờ anh bổ sung thêm nếu vẽ pl từ phải qua trái thì text xoay song song với pl theo hướng vẽ pl. 

Hề hề hề,

Đây là code mình chỉnh sửa lại. Bạn hãy test thử coi sao:

 

 

(defun c:xotxt (/ oldos sst pl obj p0 par pa1 pa2 goc etxt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "Chon tap hop text can xoay")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq pl (car (entsel "\n Chon polyline dinh huong")))
(setq obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (vlax-curve-getclosestpointto obj (cdr (assoc 11(setq etxt (entget txt)))) T)
         par (vlax-curve-getparamatpoint obj p0)
         pa1 (vlax-curve-getpointatparam obj (fix par))
         pa2 (vlax-curve-getpointatparam obj  par)
         goc (angle pa1 pa2)
)
(setq etxt (subst (cons 50 goc) (assoc 50 etxt) etxt))
(entmod etxt)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
Chúc bạn vui.

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#18 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 26 February 2013 - 11:54 AM

Hề hề hề,

Đây là code mình chỉnh sửa lại. Bạn hãy test thử coi sao:

Còn 1 số text không xoay được (các txt nằm gần đỉnh đường pl). Nhờ anh Binh kiểm tra.

 


  • 0

#19 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 26 February 2013 - 02:21 PM

Còn 1 số text không xoay được (các txt nằm gần đỉnh đường pl). Nhờ anh Binh kiểm tra.

 

Hề hề hề,

Thực ra các text này đã xoay với góc xoay bằng 0 độ đó. Lý do là điểm gần nhất trên polyline đối với điểm đăt của text trùng với đỉnh của polyline. Do vậy các điểm pa1 và pa2 là trùng nhau và góc là 0 độ.

Mình đã chỉnh sửa lại một chút để các text này xoay theo chiều đoạn polyline kế tiếp. Bạn check lại nhé.

 

(defun c:xotxt (/ oldos sst pl obj p0 par pa1 pa2 pa3 etxt)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(command "undo" "be")
(alert "Chon tap hop text can xoay")
(setq sst (acet-ss-to-list (ssget (list (cons 0 "text")))))
(setq pl (car (entsel "\n Chon polyline dinh huong")))
;;;;(setq pl (thc pl))
(setq obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (vlax-curve-getclosestpointto obj (cdr (assoc 11(setq etxt (entget txt)))) T)
         par (vlax-curve-getparamatpoint obj p0)
         pa1 (vlax-curve-getpointatparam obj (fix par))
         pa2 (vlax-curve-getpointatparam obj  par)
)
(if (not (equal pa1 pa2 0.000001))
        (setq goc (angle pa1 pa2))
        (if (setq pa3 (vlax-curve-getpointatparam obj (1+ par)))
            (setq goc (angle pa1 pa3))
            (setq goc (+ pi (angle pa1 (vlax-curve-getpointatparam obj (1- par)))))
        )
)
(setq etxt (subst (cons 50 goc) (assoc 50 etxt) etxt))
(entmod etxt)
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;     
Chúc bạn vui.

  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#20 khaosatheco

khaosatheco

    biết vẽ circle

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

Đã gửi 26 February 2013 - 06:23 PM

Hề hề hề,

Thực ra các text này đã xoay với góc xoay bằng 0 độ đó. Lý do là điểm gần nhất trên polyline đối với điểm đăt của text trùng với đỉnh của polyline. Do vậy các điểm pa1 và pa2 là trùng nhau và góc là 0 độ.

Mình đã chỉnh sửa lại một chút để các text này xoay theo chiều đoạn polyline kế tiếp. Bạn check lại nhé.

Còn 1 vấn đề với các text căn lề trái thì xoay chưa đúng (căn lề giữa thì ok).

Bác xem giúp em nhé.


  • 0