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

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

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

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.com/upfiles/3/25684_file_mau_3.dwg.

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

 

 

;; free lisp from cadviet.com
(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) 
 
)
 

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

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

 

)

 

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

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 đỡ.

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

 

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ề,...

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

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/

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

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.

  • 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

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

Ơ ơ.. 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. 

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

@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 ^^

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

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.

  • 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

@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.

 

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

Ơ ơ.. 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.
  • 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

 

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.
  • 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

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é.

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ò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é.

Hề hề hề,

Hãy gửi bản vẽ có text căn lề trái lên nhé. Trong file bạn gửi thì không thấy có các text này, bởi vậy không check đượ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

File mẫu đây bác ơi.

 

http://www.fshare.vn/file/17SU9UVZCE/

Hề hề hề,của bạn đây:

(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 obj (vlax-ename->vla-object pl))
(foreach txt sst
(setq p0 (if (or (/= (cdr (assoc 72 (setq etxt (entget txt)))) 0) (/= (cdr (assoc 73 etxt)) 0))
                  (vlax-curve-getclosestpointto obj (cdr (assoc 11 etxt)) T) 
                  (vlax-curve-getclosestpointto obj (cdr (assoc 10 etxt)) 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.

PS: bạn cũng có thể sử dụng cách của bác ketxu để lấy điểm đặt text cho nó đỡ phức tạp hơn. Vì mình chưa quan dùng các hàm vla, vlax .... nên hơi ngại. Song trường hợp này thì dùng (vlax-get ....) của bác ketxu sẽ ngắn hơn nhiều.

Cụ thể: thay thế đoạn code

(if (or (/= (cdr (assoc 72 (setq etxt (entget txt)))) 0) (/= (cdr (assoc 73 etxt)) 0))

(vlax-curve-getclosestpointto obj (cdr (assoc 11 etxt)) T)

(vlax-curve-getclosestpointto obj (cdr (assoc 10 etxt)) T)

)

bằng đoạn code đơn giản:

(vlax-curve-getclosestpointto obj (vlax-get (vlax-ename->vla-object txt) 'InsertionPoint)

và thêm code xác định biến etxt

(setq etxt (entget txt))

là OK.

Hề hề hề

  • 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


×