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.
Đăng nhập để thực hiện theo  
quocphong_ctm

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

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

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.123
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    2.676

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

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

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    2.676

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

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    2.676

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

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

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

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    2.676

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    2.676

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

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

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

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  

×