Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
13 replies to this topic

#1 lgndragon

lgndragon

    biết pan

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

Đã gửi 18 October 2015 - 09:36 PM

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 ạ


  • -1

#2 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 19 October 2015 - 07:40 AM

@lgndragon

1. Tâm quay của đường thẳng đó nằm ở đâu? điểm giữa?

2. 90 -> 45; 45 -> 22.5, vậy 0 -> ?


  • 0

#3 lgndragon

lgndragon

    biết pan

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

Đã gửi 19 October 2015 - 10:06 AM

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


  • 0

#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 19 October 2015 - 10:50 AM

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


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

#5 lgndragon

lgndragon

    biết pan

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

Đã gửi 19 October 2015 - 11:08 AM

@PHAMTHANHBINH: 
dạ ý em đâu có phải là xoay cả bản vẽ đâu ạ? ý em là xoay 1 vùng trong bản vẽ mà mình cần xoay thôi ấy ạ????


  • -1

#6 tien2005

tien2005

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 257 Bài viết
Điểm đánh giá: 94 (tàm tạm)

Đã gửi 19 October 2015 - 11:19 AM

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


  • 0

#7 lgndragon

lgndragon

    biết pan

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

Đã gửi 19 October 2015 - 11:37 AM

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


  • 0

#8 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 19 October 2015 - 12:16 PM

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


  • 0

#9 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 19 October 2015 - 12:49 PM

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)


  • 2

#10 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 19 October 2015 - 12:55 PM

Cám ơn bác chỉ giáo ...!


  • 1

#11 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 19 October 2015 - 01:16 PM

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.


  • 1

#12 lgndragon

lgndragon

    biết pan

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

Đã gửi 19 October 2015 - 02:21 PM

@quocmanh04tt
anh ơi em thử tải về nhưng không hiểu sao load lip ra lại không gõ được câu lệnh rtl ấy ạ


  • 0

#13 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 19 October 2015 - 02:32 PM

Có lẽ do lỗi diễn đàn, bạn thử copy xem ...


  • 1

#14 anti lazy

anti lazy

    biết lệnh erase

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

Đã gửi 20 October 2015 - 08:02 AM

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


  • 0