Đến nội dung


Hình ảnh
- - - - -

(Yêu cầu) Lisp tìm phân giác góc lơn nhất tạo bởi các đoạn thẳng đồng qui


  • Please log in to reply
11 replies to this topic

#1 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 05 September 2011 - 05:50 PM

Chào các bạn cadviet. Mình có vđ cần các bạn giúp đỡ như sau : http://www.cadviet.c.../phangiac_1.jpg
Có một số đoạn thẳng đồng qui, làm thế nào xác định được phân giác góc lớn nhất tạo bởi 2 đoạn thẳng kề nhau nào đó. Sau khi tìm được có thể đánh dấu bằng 1 điểm nằm trên phân giác đó và cách đỉnh đoạn h
Cám ơn các bạn (mình đã tìm kiềm nhưng không thấy đề tài này)
  • 0

#2 Nguyen Hoanh

Nguyen Hoanh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 4105 Bài viết
Điểm đánh giá: 4495 (đỉnh cao)

Đã gửi 05 September 2011 - 06:24 PM

Bạn thực hiện theo các bước sau:
- Xác định góc tuyệt đối của từng đoạn thẳng (vector) bằng lệnh (angle p1 p2) giá trị sẽ từ 0-360 độ
- Sắp xếp các đoạn thẳng theo giá trị của góc tuyệt đối. có thể sử dụng hàm vl-sort. Sau khi sắp xếp ta có được các đoạn kề nhau thực tế sẽ kề nhau trong kết quả sắp xếp.
- Sau khi sắp xếp, rà soát với từng cặp đoạn thẳng i và i+1 xem góc nào lớn nhất.
- Phần còn lại sẽ là quá dễ đối với bạn rồi.
  • 0

#3 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 11 September 2011 - 02:16 AM

Bạn thực hiện theo các bước sau:
- Xác định góc tuyệt đối của từng đoạn thẳng (vector) bằng lệnh (angle p1 p2) giá trị sẽ từ 0-360 độ
- Sắp xếp các đoạn thẳng theo giá trị của góc tuyệt đối. có thể sử dụng hàm vl-sort. Sau khi sắp xếp ta có được các đoạn kề nhau thực tế sẽ kề nhau trong kết quả sắp xếp.
- Sau khi sắp xếp, rà soát với từng cặp đoạn thẳng i và i+1 xem góc nào lớn nhất.
- Phần còn lại sẽ là quá dễ đối với bạn rồi.

Cám ơn bác. Mình chưa tập trung để viết ra đc nữa, hôm nào nếu viết xong mình đưa lên để các bác góp ý. Vào mấy mục đố vui viết lung tung thì đc chứ viết một cái này mình vẫn chưa làm xong
  • 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 12 September 2011 - 01:33 AM

Cám ơn bác. Mình chưa tập trung để viết ra đc nữa, hôm nào nếu viết xong mình đưa lên để các bác góp ý. Vào mấy mục đố vui viết lung tung thì đc chứ viết một cái này mình vẫn chưa làm xong


Hề hề hề,
Bác Trungngamy thử xài cái này xem có ưng ý không nhé.


(defun c:tpg (/ pt linlst elst glst h p1 p2 a n i k goc)
(setq pt (getpoint "\n Chon diem dong quy"))
(setq linlst (acet-ss-to-list (ssget "c" (polar pt (* 5 (/ pi 4)) 1) (polar pt (/ pi 4) 1) (list (cons 0 "LINE")))))

(foreach lin linlst
(setq p1 (cdr (assoc 10 (entget lin))))
(setq p2 (cdr (assoc 11 (entget lin))))
(if (and (not (equal p1 pt 0.0001)) (not (equal p2 pt 0.0001)))
(setq linlst (vl-remove lin linlst))
)
)
(setq elst (list))
(setq glst (list))
(setq h (getdist pt "\n Chon khoang cach toi diem danh dau: "))
(setvar "pdmode" 3)
(foreach lin linlst
(setq p1 (cdr (assoc 10 (entget lin))))
(setq p2 (cdr (assoc 11 (entget lin))))
(if (equal p1 pt 0.0001)
(setq p1 p2)
)
(setq a (angle pt p1))
(setq elst (append elst (list (list lin a))))
)
(setq elst (vl-sort elst '(lambda (x y) (> (cadr x) (cadr y)))))
(setq n (length elst))
(foreach x elst
(setq i (vl-position x elst))
(if (< (1+ i) n)
(setq goc (- (cadr x) (cadr (nth (1+ i) elst))))
(setq goc (+ (cadr (nth (1- n) elst)) (- (* pi 2) (cadr (nth 0 elst)))))
)
(setq glst (append glst (list goc)))
)
(setq k (vl-position (car (vl-sort glst '>)) glst))
(if (< (1+ k) n)
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (cadr (nth (1+ k) elst))) 2) h) )
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (* pi 2) (cadr (nth 0 elst))) 2) h) )
)
)

Mình mới viết cho trường hợp là các line đồng quy, còn các polyline thì chưa xét. Nếu bác thấy cần thì mình sẽ bổ sung sau.
Chúc bác vui...

(Đã bổ sung code để loại các line không đồng quy tại mút.)

Bài viết đã được chỉnh sửa nội dung bởi phamthanhbinh: 12 September 2011 - 04:31 PM
Bổ sung code loại các đối tượng line không đồng quy tại mút.

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

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 12 September 2011 - 08:38 AM


Hề hề hề,
Bác Trungngamy thử xài cái này xem có ưng ý không nhé.



(defun c:tpg (/ pt linlst elst glst h p1 p2 a n i k goc)
(setq pt (getpoint "\n Chon diem dong quy"))
(setq linlst (acet-ss-to-list (ssget "c" (polar pt (* 5 (/ pi 4)) 1) (polar pt (/ pi 4) 1) (list (cons 0 "LINE")))))
(setq elst (list))
(setq glst (list))
(setq h (getdist pt "\n Chon khoang cach toi diem danh dau: "))
(setvar "pdmode" 3)
(foreach lin linlst
(setq p1 (cdr (assoc 10 (entget lin))))
(setq p2 (cdr (assoc 11 (entget lin))))
(if (equal p1 pt 0.0001)
(setq p1 p2)
)
(setq a (angle pt p1))
(setq elst (append elst (list (list lin a))))
)
(setq elst (vl-sort elst '(lambda (x y) (> (cadr x) (cadr y)))))
(setq n (length elst))
(foreach x elst
(setq i (vl-position x elst))
(if (< (1+ i) n)
(setq goc (- (cadr x) (cadr (nth (1+ i) elst))))
(setq goc (+ (cadr (nth (1- n) elst)) (- (* pi 2) (cadr (nth 0 elst)))))
)
(setq glst (append glst (list goc)))
)
(setq k (vl-position (car (vl-sort glst '>)) glst))
(if (< (1+ k) n)
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (cadr (nth (1+ k) elst))) 2) h) )
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (* pi 2) (cadr (nth 0 elst))) 2) h) )
)
)

Mình mới viết cho trường hợp là các line đồng quy, còn các polyline thì chưa xét. Nếu bác thấy cần thì mình sẽ bổ sung sau.
Chúc bác vui...

Chào bác Bình, bác TrungNgaMy
Theo Tue_NV thì ta không cần phải chọn điểm đồng quy như bác Bình mà nên sử dụng Lisp để làm việc đó. (bỏ bước này vì nó không cần thiết lắm)
- Chọn các đoạn thẳng.
- Lấy 1 đoạn thẳng làm chuẩn. Gọi là đoạn thẳng L.
- Xét giao điểm của đoạn thẳng L với các đoạn thẳng còn lại. Nếu các giao điểm trùng nhau hoàn toàn thì giao điểm đó chính là điểm đồng quy.
- Các ý tiếp theo thì như ý kiến bác Hoành ở trên

Em chưa đọc code của bác Bình, nhưng thấy chạy thì không đúng như yêu cầu của Bác TrungNgaMy
  • 0

#6 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 September 2011 - 09:09 AM

Bác Bình sáng tạo, chọn điểm đồng quy rồi từ đó suy ra các đường thẳng cần thao tác, tuy nhiên cũng không loại trừ khả năng bị lẫn với các đường thẳng khác ^^
E chạy thấy kết quả OK, không biết là còn mắc vào trường hợp nào không
  • 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


#7 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 12 September 2011 - 11:14 AM


Hề hề hề,
Bác Trungngamy thử xài cái này xem có ưng ý không nhé.



(defun c:tpg (/ pt linlst elst glst h p1 p2 a n i k goc)
(setq pt (getpoint "\n Chon diem dong quy"))
(setq linlst (acet-ss-to-list (ssget "c" (polar pt (* 5 (/ pi 4)) 1) (polar pt (/ pi 4) 1) (list (cons 0 "LINE")))))
(setq elst (list))
(setq glst (list))
(setq h (getdist pt "\n Chon khoang cach toi diem danh dau: "))
(setvar "pdmode" 3)
(foreach lin linlst
(setq p1 (cdr (assoc 10 (entget lin))))
(setq p2 (cdr (assoc 11 (entget lin))))
(if (equal p1 pt 0.0001)
(setq p1 p2)
)
(setq a (angle pt p1))
(setq elst (append elst (list (list lin a))))
)
(setq elst (vl-sort elst '(lambda (x y) (> (cadr x) (cadr y)))))
(setq n (length elst))
(foreach x elst
(setq i (vl-position x elst))
(if (< (1+ i) n)
(setq goc (- (cadr x) (cadr (nth (1+ i) elst))))
(setq goc (+ (cadr (nth (1- n) elst)) (- (* pi 2) (cadr (nth 0 elst)))))
)
(setq glst (append glst (list goc)))
)
(setq k (vl-position (car (vl-sort glst '>)) glst))
(if (< (1+ k) n)
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (cadr (nth (1+ k) elst))) 2) h) )
(command "point" (polar pt (/ (+ (cadr (nth k elst)) (* pi 2) (cadr (nth 0 elst))) 2) h) )
)
)

Mình mới viết cho trường hợp là các line đồng quy, còn các polyline thì chưa xét. Nếu bác thấy cần thì mình sẽ bổ sung sau.
Chúc bác vui...

Chà, bác PTB dùng chiêu dưới đây để chọn các đường đồng quy là hơi bị nguy hiểm.
(setq linlst (acet-ss-to-list (ssget "c" (polar pt (* 5 (/ pi 4)) 1) (polar pt (/ pi 4) 1) (list (cons 0 "LINE")))))
Vì con số 1 này đôi lúc nó "lớn" đến nổi có thể chọn nhầm thêm các line khác đấy!
Thậm chí dùng
(setq linlst (acet-ss-to-list (ssget "c" pt pt (list (cons 0 "LINE")))))
Cũng vẫn còn tiềm tàng nguy hiểm (tuỳ theo mức độ zoom) bác PTB ạ! Chắc phải chọn kiểu khác thôi.
Thân thương!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#8 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 September 2011 - 02:37 PM

Theo em có thể bắt đầu như thế này :

(setq
ss (acet-ss-to-list (ssget (list (cons 0 "*LINE"))))
pt (car (acet-geom-intersectwith (car ss) (cadr ss) 0))
lstPnt (mapcar '(lambda(x)(car(vl-remove pt (list (vlax-curve-getStartPoint (setq tmp(vlax-ename->vla-object x)))(vlax-curve-getEndPoint tmp))))) ss)
lstAng (vl-sort (mapcar '(lambda (x) (cons (nth (vl-position x lstPnt) ss) (angle pt x))) lstPnt) '(lambda(x y) (< (cdr x)(cdr y))))
)
....
Thay dxf 10,11 của Line bằng StartPoint và EndPoint để mở rộng phạm vi đối tượng , phần còn lại theo ý bác Bình ^^
  • 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


#9 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 12 September 2011 - 02:40 PM

Chà, bác PTB dùng chiêu dưới đây để chọn các đường đồng quy là hơi bị nguy hiểm.
(setq linlst (acet-ss-to-list (ssget "c" (polar pt (* 5 (/ pi 4)) 1) (polar pt (/ pi 4) 1) (list (cons 0 "LINE")))))
Vì con số 1 này đôi lúc nó "lớn" đến nổi có thể chọn nhầm thêm các line khác đấy!
Thậm chí dùng
(setq linlst (acet-ss-to-list (ssget "c" pt pt (list (cons 0 "LINE")))))
Cũng vẫn còn tiềm tàng nguy hiểm (tuỳ theo mức độ zoom) bác PTB ạ! Chắc phải chọn kiểu khác thôi.
Thân thương!

Hề hề hề,
Các bác dạy chí phải. Chẳng qua là lúc mình bí thì chơi đại một kiểu chọn để có cái mà test thử cái phương pháp tính của mình mà thôi. Còn để cho nó thật chuẩn thì có nhẽ mình phải mót thêm ít nữa đã, chứ với cái vốn cụt lủn của mình thì chửa nghĩ ra được các bác ạ.
Để lấy một tập chọn thì mình mới biết có mỗi kiểu dùng hàm (ssget .....)
Có nhẽ theo mình thì có thể dùng cái cách chọn này kết hợp thêm với một phép kiểm tra điều kiện nữa để loại các line không có một mút trùng pt là ok. Tuy cái củ.... lisp này hơi chát, nhưng trong lúc đói thì cũng xơi tàm tạm được chứ chưa đến nỗi vứt đi cho nó phí của giời, phải không các bác nhể.....

Chào bác Bình, bác TrungNgaMy
Theo Tue_NV thì ta không cần phải chọn điểm đồng quy như bác Bình mà nên sử dụng Lisp để làm việc đó. (bỏ bước này vì nó không cần thiết lắm)
- Chọn các đoạn thẳng.
- Lấy 1 đoạn thẳng làm chuẩn. Gọi là đoạn thẳng L.
- Xét giao điểm của đoạn thẳng L với các đoạn thẳng còn lại. Nếu các giao điểm trùng nhau hoàn toàn thì giao điểm đó chính là điểm đồng quy.
- Các ý tiếp theo thì như ý kiến bác Hoành ở trên

Em chưa đọc code của bác Bình, nhưng thấy chạy thì không đúng như yêu cầu của Bác TrungNgaMy

Hề hề hề,
Chào bác Tue_NV.
Số là mình cứ theo như cái hình mà bác trungngamy đã post, nghĩa là đã và chỉ đã có các nhóm line đồng quy tại một mút của line nên mới chơi kiểu chuối là chọn điểm đồng quy của các nhóm này cho nó .... ăn cắp thời gian bác ạ. Còn đúng là mình không xét tới các trường hợp phức tạp hơn như bác nói.
@ Bác Ketxu: Có nhẽ phải dùng thêm hàm điều kiện để tách các line không đồng quy và các line không có mút trùng với điểm đồng quy bác nhể...... Để mình thử phát xem bác Trungngamy còn có thêm ý kiến gì nữa không 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.

#10 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 12 September 2011 - 04:58 PM

Theo em có thể bắt đầu như thế này :


(setq
ss (acet-ss-to-list (ssget (list (cons 0 "*LINE"))))
pt (car (acet-geom-intersectwith (car ss) (cadr ss) 0))
lstPnt (mapcar '(lambda(x)(car(vl-remove pt (list (vlax-curve-getStartPoint (setq tmp(vlax-ename->vla-object x)))(vlax-curve-getEndPoint tmp))))) ss)
lstAng (vl-sort (mapcar '(lambda (x) (cons (nth (vl-position x lstPnt) ss) (angle pt x))) lstPnt) '(lambda(x y) (< (cdr x)(cdr y))))
)
....
Thay dxf 10,11 của Line bằng StartPoint và EndPoint để mở rộng phạm vi đối tượng , phần còn lại theo ý bác Bình ^^

Hề hề hề,
Có nhẽ bác nên sửa tí chút vì nhỡ các polyline lại có nhiều phân đoạn thì cái endpoint sẽ có thể gấy rắc rối đó bác ạ. Vả lại trường hợp mà cái line nó đi qua điểm đồng quy nhưng không phải là điểm mút thì bác chọn nửa nào để xác địng góc ạ????
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.

#11 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 12 September 2011 - 09:55 PM

Dạ, Ý của em đã có trong dòng
(car(vl-remove pt (list ...
Tức là góc sẽ lấy point đầu tiên (khác điểm đồng quy trong list) để tính góc với điểm đồng quy PT. Nếu xảy ra các trường hợp sai với hình minh họa của bác TrungNgaMy thì kết quả sẽ ra sai. Điều này không thuộc phạm vi giải quyết của bài toán (vì không yêu cầu) và bác TrungNgaMy phải giải quyết từ khâu chọn đối tượng thôi.
Cũng như khi viết hàm con ta không nên bao điều kiện kiểm tra đối số vào trong nó (trừ trường hợp cần rẽ nhánh) vậy ^^
  • 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 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 12 September 2011 - 10:39 PM

Cám ơn bác Bình đã viết và các bác đã góp ý. Quả là các bác viết lisp siêu tốc. Lisp của bác bình đúng ý mình rồi. Thật ra mình đã kết cấu trong CT viết từ ngày trước có thể trả về các line đồng qui, sau đó chỉ cần một hàm xử lý tập hợp các line đó là đc. Như vậy mình có thể chế biến món mà bác Bình và các bác khác cung cấp là xong. Một lần nữa cám ơn các bác
  • 0