Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
quocphong_ctm

[Yêu cầu] Lisp tìm giao điểm 1 nhóm đường thẳng với đường Pline

Bởi quocphong_ctm , trong AutoLisp

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

quocphong_ctm    3

quocphong_ctm
Đã đăng (Đă chỉnh sửa)

Chào mọi người,

 

Mình đang rất cần 1 lisp thực hiện công việc sau:

 

- Xác định tọa độ giao điểm của các đường line với đường Polyline;

- Xuất tất cả tọa độ sang file .txt hoặc .xls với định dạng sau:

 

STT X Y

1 aa bbb

.....

- Các đường thẳng cắt đường polyline có khoảng cách do mình định ra!!!

Mình tìm trên diễn đàn thấy rất nhiều lisp xác định tọa độ giao điểm nhưng không thấy cái nào phù hợp với yêu cầu công việc của mình. Rất mong các cao thủ, lão làng trên Cadviet giúp mình!

 

Many thanks,

2597_giao_diem.jpg

Chỉnh sửa theo quocphong_ctm

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng
Chào mọi người, Mình đang rất cần 1 lisp thực hiện công việc sau: - Xác định tọa độ giao điểm của các đường line với đường Polyline; - Xuất tất cả tọa độ sang file .txt hoặc .xls với định dạng sau: STT X Y 1 aa bbb ..... - Các đường thẳng cắt đường polyline có khoảng cách do mình định ra!!! Mình tìm trên diễn đàn thấy rất nhiều lisp xác định tọa độ giao điểm nhưng không thấy cái nào phù hợp với yêu cầu công việc của mình. Rất mong các cao thủ, lão làng trên Cadviet giúp mình! Many thanks, 2597_giao_diem.jpg

Hề hề hề,

Bạn dùng thử cái này coi đã ưng ý chưa nhé.


(defun c:gtdb (/ oldos ent obj p1 p2 kc ent1 plst sspl p txt k)
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq ent (car (entsel "\n Chon polyline day bien"))
         obj (vlax-ename->vla-object ent)
         p1 (vlax-curve-getstartpoint obj)
         p2 (vlax-curve-getendpoint obj)
         kc (getreal "\n Nhap khoang cach chia: ")
)
(if (> (car p2) (car p1))
   (command "line" p1 (list (car p2) (cadr p1)) "")
   (commnand "line" p2 (list (car p1) (cadr p2)) "")
)
(setq ent1 (entlast))
(command "measure" ent1 kc)
(setq sspl (acet-ss-to-list (ssget "p"))
         plst (list) )
(foreach ep sspl
        (setq p (cdr (assoc 10 (entget ep))))
        (setq plst (append plst (list (vlax-curve-getclosestpointtoprojection obj p (list 0 1 0) nil))))
)
(if (> (car p2) (car p1))
   (progn 
        (setq plst (cons p1 plst)
                  plst (append plst (list p2))  )
   )
   (progn
        (setq plst (cons p2 plst)
                  plst (append plst (list p1))  )
   )
)
(command "erase" ent1 "p" "")
(setq  fn (getfiled "Select Data File" "" "csv" 1)
           f (open fn "w")
           k 1 
)
(write-line (strcat "STT" "," "X" "," "Y") f)
(foreach p plst
     (setq txt (strcat (rtos k 2 0) "," (rtos (car p) 2 4) "," (rtos (cadr p) 2 4))
              k (1+ k) )
     (write-line txt f)
)
(close f)
(setvar "osmode" oldos)
(princ)
)

Chúc bạn vui....

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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng

Lisp hoàn chỉnh cho bạn đây: đường cong đáy biển là Curve bất kỳ.

;Doan Van Ha - CADViet.com - Ngay 31/7/2012
;Muc dich: Xuat file cac giao diem cua 1 Curve voi cac duong thang // cach deu.
(defun C:HA( / obj1 obj2 kc cdai pd pc pt x fn pw gd)
(vl-load-com)
(setq obj1 (vlax-ename->vla-object (car (entsel "\nChon duong cong day bien: "))))
(setq kc (getreal "\nNhap khoang cach: "))
(setq cdai (- (car (setq pc (vlax-curve-getEndPoint obj1))) (car (setq pd (vlax-curve-getStartPoint obj1)))))
(if (> (- (car pc) (car pd)) 0) (setq pt pd) (setq pt pc))
(setq x 0)
(setq fn (getfiled "Chon file de xuat ket qua" (getvar "dwgprefix") "xls" 1))
(setq pw (open fn "w"))
(write-line (strcat "STT" "\t" "X" "\t" "Y") pw)
(repeat (+ (fix (abs (/ cdai kc))) 1)
 (setq obj2 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (polar pt (/ pi 2) 1))))))
 (setq gd (vlax-invoke obj1 'IntersectWith obj2 acExtendOtherEntity))
 (write-line (strcat (itoa (1+ x)) "\t" (rtos (car gd) 2 2) "\t" (rtos (cadr gd) 2 2)) pw)
 (setq x (1+ x))
 (setq pt (polar pt 0 kc)))
(close pw)
(command "u")
(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

gia_bach    1.549

gia_bach
Đã đăng

Lisp hoàn chỉnh cho bạn đây: đường cong đáy biển là Curve bất kỳ.

;Doan Van Ha - CADViet.com - Ngay 31/7/2012
;Muc dich: Xuat file cac giao diem cua 1 Curve voi cac duong thang // cach deu.
................
(repeat (+ (fix (abs (/ cdai kc))) 1)
 (setq obj2 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 (polar pt (/ pi 2) 1))))))
................

Một chút ý kiến mang tính cá nhân : trong t/hợp cần tối ưu tốc độ, có lẽ tịnh tiến LINE (theo phương ngang) sẽ nhanh hơn việc liên tục EntMakeX ???

  • 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

Tue_NV    3.912

Tue_NV
Đã đăng

Một chút ý kiến mang tính cá nhân : trong t/hợp cần tối ưu tốc độ, có lẽ tịnh tiến LINE (theo phương ngang) sẽ nhanh hơn việc liên tục EntMakeX ???

Em thì nghĩ việc tạo Line, tịnh tiến Line rồi xóa Line đi sẽ không nhanh bằng việc lấy giao điểm bằng hàm inters (Lấy giao điểm của 4 điểm, không tạo Line, không tịnh tiến Line) :)

Tuy nhiên, Cái này chỉ áp dụng với Pline có phân đoạn là đoạn thẳ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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng

Kính gởi 2 bác Tue_NV và Gia_Bach!

Thực ra thì bài toán ban đầu (mà nay đã modify) khiến chúng ta không quan tâm đến tốc độ (nếu tôi nhớ không nhầm thì chỉ khoảng 50 line mà thôi).

Tuy nhiên, trong trường hợp tổng quát thì tốc độ vẫn rất đáng quan tâm. Về ý kiến của 2 bác thì tôi có ý kiến chủ quan thế này:

@Gia_Bach: Tạo 1 line, sau đó Move dần, cuối cùng thì xoá nó (việc tạo và xoá line chỉ thực hiện duy nhất 1 lần), có lẽ sẽ nhanh hơn tạo nhiều line như tôi đã làm.

@Tue_NV: Có lẽ dùng inters 4 điểm (nếu pline không arc) sẽ nhanh hơn move line, nhưng lại gặp một trở ngại là phải duyệt tìm cặp điểm trên pline để tìm giao. Vậy liệu điều này có làm chậm quá trình nhiều không?

  • Vote tăng 3

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

quocphong_ctm    3

quocphong_ctm
Đã đăng

Mình rất cảm ơn các bác vì đã giúp mình viết ra 1 lisp rất có ý nghĩa đối với công việc của mình.

Mình có một yêu cầu nhỏ trong lisp này muốn mạn phép nhờ các bác chỉnh sửa lisp để hoàn thiện hơn như sau:

- Mình có một profile như hình vẽ bên dưới:

Untitled.jpg

- Bây giờ mình muốn chia profile này thành các đoạn có chiều dài bằng nhau biết trước (có nghĩa là chiều dài của các đoạn chia dọc theo profile bằng nhau <-- em nghĩ việc này tương đối khó vì lisp phải tính được không chỉ chiều dài của line mà còn cả chiều dài của 1 đường cong, tương tự như lệnh "List" trong CAD);

- Tọa độ các điểm chia này sẽ được xuất thành bảng Excel với format giống như lisp trước;

- Nếu được em nhờ các bác viết giúp em cả 2 trường hợp Profile là đường cong trơn và profile là đường polyline (tập hợp của các line).

 

Thanks các bác nhiều nhiều lắm!!!

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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng

1). "Thank" mà thấy thank đâu?

2). "Mình đang rất cần" sao hỏi từ tháng 7 mà bây giờ sắp tháng 11 mới ngó ngàng tới?

3). Chỉ cần 1 trường hợp tổng quát thôi, bất kể nó là cong hay thẳng.

  • 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

quocphong_ctm    3

quocphong_ctm
Đã đăng

Sorry bác Doan Van Ha!

 

Thực ra lisp lần trước mình áp dụng được rồi. Tuy nhiên, trong quá trình sử dụng mới phát sinh thêm 1 số yêu cầu như trên. Theo mình nghĩ, yêu cầu này khác so với lisp lần trước ở chỗ: các đoạn chia đều là dọc theo đường profile (line, pline hay spline...) trong khi lisp lần trước các khoảng chia đều nằm trên 1 đường thẳng song song với trụ hoành (trục nằm ngang).

 

Do sau 1 thời gian sử dụng mình mới thấy điểm khác nhau này nên mình mới quay lại nhờ các bác giúp đỡ thêm lần nữa. Chân thành cảm ơn và cớ cơ hội mời các bác ly cà phê :ph34r:

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    2.984

ketxu
Đã đăng

Sự khác biệt rõ ràng vậy mà mấy tháng rồi bạn mới thấy sao :| Với việc length tính theo đối tượng thì code còn nhàn hơn nữa

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

quocphong_ctm    3

quocphong_ctm
Đã đăng

Mình không biết gì về lisp nên có dễ hay khó đối với mình đều ... khó cả. Với lại, do dự án mình làm từng giai đoạn từ FEED đến Detail nên độ chính xác cần cải thiện. Các bác up giúp mình cái lisp đó với :ph34r:

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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng

OK, để chiều tôi sửa lại cho! Nhớ rằng: khi đã post câu hỏi thì quan tâm đến câu hỏi tí, chứ sao mà chẳng ngó ngàng mấy tháng liề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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng

Lisp đây bạn!

;Doan Van Ha - CADViet.com - Ngay 31/10/2012
;Muc dich: Xuat file cac toa do cac diem cach nhau 1 khoang cho truoc tren 1 Curve.
(defun C:HA( / ent kc pd pc pt x fn pw)
(setq ent (car (entsel "\nChon Curve Profile: ")))
(setq kc (getreal "\nNhap khoang cach can chia doc theo Profile: "))
(setq pd (vlax-curve-getStartPoint ent) pc (vlax-curve-getEndPoint ent))
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (> (- (car pc) (car pd)) 0)
 (setq pt pd)
 (setq pt pc))
(setq fn (getfiled "Chon file de xuat ket qua" (getvar "dwgprefix") "xls" 1))
(setq pw (open fn "w"))
(setq x 1)
(write-line (strcat "STT" "\t" "X" "\t" "Y") pw)
(write-line (strcat "1" "\t" (rtos (car pd) 2 2) "\t" (rtos (cadr pd) 2 2)) pw)
(repeat (fix (/ len kc))
 (setq pt (GetP pd pc (* kc x) ent))
 (write-line (strcat (itoa (setq x (1+ x))) "\t" (rtos (car pt) 2 2) "\t" (rtos (cadr pt) 2 2)) pw))
(close pw)
(princ))
;----- LÊy ®iÓm p trªn Curve c¸ch pg kho¶ng c¸ch kc, víi ph lµ ®iÓm ®Þnh h­íng trªn Curve.
(defun GetP (pg ph kc cur / dg dh dp)
(setq dg (vlax-curve-getDistAtPoint cur pg))
(setq dh (vlax-curve-getDistAtPoint cur ph))
(if (> dh dg)
 (setq dp (+ dg kc))
 (setq dp (- dg kc)))
(vlax-curve-getPointAtDist cur dp))

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

quocphong_ctm    3

quocphong_ctm
Đã đăng

Chân thành cảm ơn bác Ha. Bác cho em xin số phone cuối tuần đi cafe giao lưu nhé. Em ở quận 12.

Lisp lần trước bác viết cho em xài rất ok. Em có cảm ơn bác rồi mà :blush: Gửi vào 31 July 2012 - 04:40 PM. Do yêu cầu công việc nên em mới đào mồ topic này lên nhờ bác update giúp em lần nữa. :ph34r:

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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Anh Đoàn Văn Hà ơi.Em nhờ anh sửa cai lisp trên của anh thành vẽ đường polyline đi qua các giao điểm như lisp trên anh đã xuất ra file .xls được không anh.

Hề hề hề,

Cái này trên diễn đàn có nhiều rừi mà, hãy chịu khó tìm kiếm một chút cho bớt công sức của các bác ấy 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

giatruat    1

giatruat
Đã đăng
Vào lúc 1/8/2012 tại 08:27, Doan Van Ha đã nói:

Đúng thế bác Gia_Bach ạ! Thanks.

Xin lỗi đã lôi chủ đề cũ lên. Anh cho em hỏi với trường hợp này nhưng em gặp phải chỗ đáy biển hình vòm. Có nghĩa là trên 1 đường line thẳng lisp tạo ra sẽ giao với đáy biển nhiều hơn 1 chỗ thì có cách nào giải quyết k ạ. Em cám ơn nhiều

day bien.JPG

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

Doan Van Ha    3.190

Doan Van Ha
Đã đăng
10 phút trước, giatruat đã nói:

Xin lỗi đã lôi chủ đề cũ lên. Anh cho em hỏi với trường hợp này nhưng em gặp phải chỗ đáy biển hình vòm. Có nghĩa là trên 1 đường line thẳng lisp tạo ra sẽ giao với đáy biển nhiều hơn 1 chỗ thì có cách nào giải quyết k ạ. Em cám ơn nhiều

Giờ già rồi không đủ sức lặn xuống đáy biển nữa. Xem có bạn trẻ nào lặn giỏi thì nhờ nhé!

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

giatruat    1

giatruat
Đã đăng
Vào lúc 29/5/2021 tại 16:45, Doan Van Ha đã nói:

Giờ già rồi không đủ sức lặn xuống đáy biển nữa. Xem có bạn trẻ nào lặn giỏi thì nhờ nhé!

Dạ vâng. Em cám ơn anh

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×