Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
20 replies to this topic

#1 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 July 2012 - 01:48 PM

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,
Hình đã gửi

Bài viết đã được chỉnh sửa nội dung bởi quocphong_ctm: 31 July 2012 - 02:17 PM

  • 0

#2 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 31 July 2012 - 04:28 PM

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, Hình đã gửi

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

#3 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 31 July 2012 - 04:36 PM

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))

  • 1

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


#4 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 July 2012 - 04:40 PM

Great! Thanks your all support! :ph34r: All problems have been resolved! kaka
  • 0

#5 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 01 August 2012 - 07:44 AM

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 ???
  • 2

#6 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 01 August 2012 - 08:27 AM

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

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


#7 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 01 August 2012 - 09:14 AM

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

#8 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 01 August 2012 - 09:51 AM

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?
  • 3

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


#9 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 30 October 2012 - 05:00 PM

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:
Hình đã gửi
- 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!!!
  • 0

#10 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 30 October 2012 - 05:13 PM

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.
  • 1

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


#11 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 October 2012 - 11:32 AM

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:
  • 0

#12 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 31 October 2012 - 11:42 AM

Thôi, đổi cafe lấy "Like This" cho nó rẻ! :lol:
  • 1

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


#13 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 31 October 2012 - 11:48 AM

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


#14 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 October 2012 - 11:58 AM

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:
  • 0

#15 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 31 October 2012 - 12:34 PM

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


#16 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 31 October 2012 - 03:36 PM

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&#202;y &#174;i&#211;m p tr&#170;n Curve c&#184;ch pg kho&#182;ng c&#184;ch kc, v&#237;i ph l&#181; &#174;i&#211;m &#174;&#222;nh h&#173;&#237;ng tr&#170;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))

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


#17 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 October 2012 - 04:20 PM

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:
  • 0

#18 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 31 October 2012 - 04:24 PM

Đã nói là hóa giá cafe sang thứ khác cho rẻ rồi mà. Bạn mời cafe thì bao luôn vé máy bay nhé! :lol:
  • 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.


#19 quocphong_ctm

quocphong_ctm

    biết vẽ circle

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

Đã gửi 31 October 2012 - 04:50 PM

Vậy là hiểu rồi :blink: Bác không ở TPHCM. Thôi thì chúc bác sức khỏe và thành công vậy.
  • 0

#20 hoangthaivecc

hoangthaivecc

    Chưa sử dụng CAD

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

Đã gửi 03 September 2013 - 02:24 PM

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.


  • 0