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

[Yêu Cầu]Nhờ Mọi Người Giúp Đỡ Về Lisp Xoay Góc Đoạn Thẳng Và Text

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

em xin nhờ mọi người hỗ trợ lập trình cho em 1 cái lisp để em có thể dễ dàng hơn trong công việc. Bài toán của em là giả sử có 1 vùng bản vẽ gồm có các đối tượng đường thẳng và text đang có các góc là 0 độ (nằm ngang), 90 độ (vuông góc) , 45 độ ,

Bây giờ em muốn dùng 1 lisp để quét toàn bộ các đối tượng đó và sau đó ấn enter, sau khi ấn enter xong thì các đường thẳng và text sẽ tự động chuyển góc cho mình : đường thẳng nào đang vuông góc thì sẽ đổi thành góc 45, đường thẳng nào đang 45 thì sẽ thành 22.5 cho mình.

Em đã thử tìm kiếm trên diễn đàn nhưng hình như chưa có ai làm về cái này, mong mọi người chỉ bảo giúp đỡ cho em với ạ

  • 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

@quocmanh04tt

1. Vâng tâm quay của đường thẳng nằm ở giữa, cả text cũng vậy ạ.

2. góc 0 độ giữ nguyên không thay đổi ạ, các đường thẳng nằm ngang ấy ạ

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

@quocmanh04tt

 

1. Vâng tâm quay của đường thẳng nằm ở giữa, cả text cũng vậy ạ.

 

2. góc 0 độ giữ nguyên không thay đổi ạ, các đường thẳng nằm ngang ấy ạ

Hề hề hề,

Bạn đã nghĩ kỹ chưa vậy, Sau khi xoay xong thì bản vẽ sẽ như thế nào??? Hãy gửi một bản vẽ mẫu trước và sau khi xoay lên.

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ái niệm góc của line bạn định nghĩa mơ hồ. 0 thì không quay, 180d (nằm ngang) ->90d, 90d ->45d, 270d (thang dung nhu 90) -> 135d. Quay như vậy có đúng ý bạn không? Tư duy thêm đi Bạn. Khi Bạn vẽ line thì xác định được điểm đầu và cuối, vẽ xong rồi nhìn đường line thi đâu là cuối là đầ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

@tien 2005: 

trong bản vẽ của em thì trước khi dùng lip này thì chỉ có 2 đường: đường nằm ngang, đường chéo 45 và đường vuông góc, giờ ý của em là khi em dùng lip này thì đường nằm ngang giữ nguyên, đường vuông góc thành đường chéo và đường chéo 45 thành chéo 22.5 thôi ạ. Em đã nói rất rõ như vậy rồi mà sao mọi người cứ suy diễn các góc còn lại làm gì vậy ạ

Còn vấn đề điểm gốc quay thì em không quan trọng ạ, muốn quay từ gốc nào cũng đượ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

Bạn thử cái này xem (Tuy nhiên Alignment của text chưa trả về ban đầu được nó chuyển sang MiddleCenter ):

(defun c:rtl  (/ adoc lst lst-line lst-text ss ang dis hei mpt mid stp ins bou len minp maxp)
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (prompt "\nSelect LINE, TEXT, MTEXT!")
 (if (setq ss (ssget '((0 . "*TEXT,LINE"))))
  (progn (setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
         (foreach obj  lst
          (if (eq (vla-get-objectname obj) "AcDbText")
           (setq lst-text (cons obj lst-text))
           (setq lst-line (cons obj lst-line))))
         (vla-endundomark adoc)
         (vla-startundomark adoc)
         (foreach obj  lst-text
          (setq bou (vla-getboundingbox obj 'minp 'maxp)
                len (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp)))
                ang (vlax-get obj 'rotation)
                hei (vlax-get obj 'height)
                ins (vlax-get obj 'insertionpoint)
                mpt (polar ins ang (* 0.5 len)))
          (vla-put-Alignment Obj acAlignmentMiddleCenter)
          (vla-put-TextAlignmentPoint Obj (vlax-3d-point (polar mpt (+ ang (* 0.5 pi)) (* 0.5 hei))))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)) (vla-put-rotation obj (* 0.125 pi)))
                ((or (equal ang (* 1.5 pi)) (equal ang (* 0.5 pi))) (vla-put-rotation obj (* 0.25 pi)))
                (t)))
         (foreach obj  lst-line
          (setq stp (vlax-get obj 'startpoint)
                ang (vla-get-angle obj)
                dis (vla-get-Length obj)
                mid (polar stp ang (* 0.5 dis)))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)
                     (equal ang (* 0.75 pi) 10e-8)
                     (equal ang (* 1.25 pi) 10e-8)
                     (equal ang (* 1.75 pi) 10e-8))
                 (vlax-put obj 'startpoint (polar mid (* 0.125 pi) (* 0.5 dis)))
                 (vlax-put obj 'endpoint (polar mid (* 1.125 pi) (* 0.5 dis))))
                ((or (equal ang (* 0.5 pi)) (equal ang (* 1.5 pi)))
                 (vlax-put obj 'startpoint (polar mid (* 1.25 pi) (* 0.5 dis)))
                 (vlax-put obj 'endpoint (polar mid (* 0.25 pi) (* 0.5 dis))))
                (t)))
         (vla-endundomark adoc)))
 (princ))

P/S: đường thẳng của bạn phải là LINE.​

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ử cái này xem (Tuy nhiên Alignment của text chưa trả về ban đầu được nó chuyển sang MiddleCenter ):

(defun c:rtl  (/ adoc lst lst-line lst-text ss ang dis hei mpt mid stp ins bou len minp maxp)
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (prompt "\nSelect LINE, TEXT, MTEXT!")
 (if (setq ss (ssget '((0 . "*TEXT,LINE"))))
  (progn (setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
         (foreach obj  lst
          (if (eq (vla-get-objectname obj) "AcDbText")
           (setq lst-text (cons obj lst-text))
           (setq lst-line (cons obj lst-line))))
         (vla-endundomark adoc)
         (vla-startundomark adoc)
         (foreach obj  lst-text
          (setq bou (vla-getboundingbox obj 'minp 'maxp)
                len (- (car (vlax-safearray->list maxp)) (car (vlax-safearray->list minp)))
                ang (vlax-get obj 'rotation)
                hei (vlax-get obj 'height)
                ins (vlax-get obj 'insertionpoint)
                mpt (polar ins ang (* 0.5 len)))
          (vla-put-Alignment Obj acAlignmentMiddleCenter)
          (vla-put-TextAlignmentPoint Obj (vlax-3d-point (polar mpt (+ ang (* 0.5 pi)) (* 0.5 hei))))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)) (vla-put-rotation obj (* 0.125 pi)))
                ((or (equal ang (* 1.5 pi)) (equal ang (* 0.5 pi))) (vla-put-rotation obj (* 0.25 pi)))
                (t)))
         (foreach obj  lst-line
          (setq stp (vlax-get obj 'startpoint)
                ang (vla-get-angle obj)
                dis (vla-get-Length obj)
                mid (polar stp ang (* 0.5 dis)))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)
                     (equal ang (* 0.75 pi) 10e-8)
                     (equal ang (* 1.25 pi) 10e-8)
                     (equal ang (* 1.75 pi) 10e-8))
                 (vlax-put obj 'startpoint (polar mid (* 0.125 pi) (* 0.5 dis)))
                 (vlax-put obj 'endpoint (polar mid (* 1.125 pi) (* 0.5 dis))))
                ((or (equal ang (* 0.5 pi)) (equal ang (* 1.5 pi)))
                 (vlax-put obj 'startpoint (polar mid (* 1.25 pi) (* 0.5 dis)))
                 (vlax-put obj 'endpoint (polar mid (* 0.25 pi) (* 0.5 dis))))
                (t)))
         (vla-endundomark adoc)))
 (princ))

P/S: đường thẳng của bạn phải là LINE.​

Tại sao phải Vla-Put, Vlax-Put nhiều thế nhỉ ?

Dùng (Vla-Rotate obj center angle) sẽ gọn hơn. (không thay đổi text align)

  • 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

Tại sao phải Vla-Put, Vlax-Put nhiều thế nhỉ ?

Dùng (Vla-Rotate obj center angle) sẽ gọn hơn. (không thay đổi text align)

 

Sửa lại theo chỉ dẫn của bác gia_bach:

​(defun c:rtl  (/ mid-point adoc lst lst-line lst-text ss ang dis hei mpt mid stp minp maxp)
 (defun mid-point (p1 p2) (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.0)) p1 p2))
 (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (prompt "\nSelect LINE, TEXT, MTEXT!")
 (if (setq ss (ssget '((0 . "*TEXT,LINE"))))
  (progn (setq lst (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
         (foreach obj  lst
          (if (eq (vla-get-objectname obj) "AcDbLine")
           (setq lst-line (cons obj lst-line))
           (setq lst-text (cons obj lst-text))))
         (vla-endundomark adoc)
         (vla-startundomark adoc)
         ;; Text
         (foreach obj  lst-text
          (vla-getboundingbox obj 'minp 'maxp)
          (setq ang (vlax-get obj 'rotation)
                mpt (vlax-3d-point (mid-point (vlax-safearray->list maxp) (vlax-safearray->list minp))))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)) (vla-Rotate obj mpt (* -0.125 pi)))
                ((or (equal ang (* 1.5 pi)) (equal ang (* 0.5 pi))) (vla-Rotate obj mpt (* -0.25 pi)))
                (t)))
         ;; Line
         (foreach obj  lst-line
          (setq stp (vlax-get obj 'startpoint)
                ang (vla-get-angle obj)
                dis (vla-get-Length obj)
                mid (vlax-3d-point (polar stp ang (* 0.5 dis))))
          (cond ((or (equal ang (* 0.25 pi) 10e-8)
                     (equal ang (* 0.75 pi) 10e-8)
                     (equal ang (* 1.25 pi) 10e-8)
                     (equal ang (* 1.75 pi) 10e-8))
                 (vla-Rotate obj mid (* -0.125 pi)))
                ((or (equal ang (* 0.5 pi)) (equal ang (* 1.5 pi))) (vla-Rotate obj mid (* -0.25 pi)))
                (t)))
         (vla-endundomark adoc)))
 (princ))

P/S: + Cái đầu không được với MText -> Sai.

  • 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

Yêu cầu lisp mà bản vẽ để test cũng không có, diễn đạt thì mù mờ đến nỗi phải hỏi đến 3 lần nhưng có lẽ cũng chưa rõ ràng vì vậy quocmanh04tt phải đoán để viết. Vì phải đoán nên lisp khó mà đúng y/c được.

VD: góc 45 độ là theo ox hay theo phương ngang,

bạn quocmanh04tt hiểu theo cách 2, nhưng không rõ là với góc 135 thì

- Để nguyên

- Xoay về 22.5 (như lisp đầu)

- Xoay về 157.5

Đến lisp sau thì rút gọn nhưng sai luôn.

Ngoài ra trong code lúc thì equal 10e-8 (sao không ghi 1e-7), lúc thì không

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


×