Đến nội dung


Hình ảnh
* * * * - 7 Bình chọn

[Hỏi]Đố vui với LISP


  • Please log in to reply
391 replies to this topic

#41 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 13 September 2011 - 02:08 PM

Hề hề hề,
Hinh như ý của bác ketxu là phải có cả cái code DCL để có được cái hộp thoại giống như bạn ấy hiển thị cơ chứ không phải chỉ là code lisp để gọi hộp thoại.....
Hề hề hề.
Về cái khoản DCL này thì mình vẫn còn đang phải mót, chửa thể thi thố gì được. Tranh thủ ngồi đợi các bác ra tay để mót vậy....
Hề hề hề...

Hề hề hề,
Code DCL để có được cái hộp thoại trên nằm ở acad.dcl nên không cần viết nữa bác ạ. Khi cần, thì gọi nó ra thôi. Còn nếu bác muốn xem mặt mũi code DCL như thế nào, bác cứ mở acad.dcl ra là có.
  • 1

#42 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 13 September 2011 - 04:50 PM

Ồ ồ, giờ thì em đã hiểu. Tại dốt quá nên bác giải thích mấy bài mới vỡ ra khái niệm Line gần điểm nhất của bác ^^ Thế thì vòng tròn tưởng tượng mần chi ^^
Giải thuật đầu tiên :
- Dữ liệu toàn là Line nên entmakex Line invisible, kiểm tra "khoảng cách Line tới điểm" pt bằng hàm
(distance pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object (setq ent (entmakex (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)(cons 60 1))))) pt))
C1 : kiểm tra distance này với distance trước, làm theo kiểu nổi bọt ^^
C2 :
- Append tất cả vào 1 list Distance, 1 list ename
- Dùng apply 'min để lấy khoảng cách nhỏ nhất + vl-position tương ứng để lấy ename -> suy ra đường thẳng
- Del toàn bộ list ename


Nhìn qua code của bác ... mình chẳng hiểu gì lắm vì mình chưa có kiến thức về vl. Hôm nào rãnh, bác viết thêm chút chút cho đúng nghĩa giải trí để anh em chứng thực một tý.
Nhưng bác nhớ đầu bài chỉ cho bác tọa độ của line và số thứ tự thôi đấy, bác kg thề dùng những hàm liên quan đến truy xuất dữ liệu đối tượng đâu nhé. ý của mình có thể hình dung như vầy : nếu có file text chứa stt, tọa độ như là (stt x1 y1 x2 y2), khi trên bản vẽ trống trơn, đọc file đó vào xử lý (nhưng kg vẽ chúng ra cad), vẫn tìm đc đáp số. Cám ơn bác
  • 0

#43 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 13 September 2011 - 05:04 PM


Nhìn qua code của bác ... mình chẳng hiểu gì lắm vì mình chưa có kiến thức về vl. Hôm nào rãnh, bác viết thêm chút chút cho đúng nghĩa giải trí để anh em chứng thực một tý.
Nhưng bác nhớ đầu bài chỉ cho bác tọa độ của line và số thứ tự thôi đấy, bác kg thề dùng những hàm liên quan đến truy xuất dữ liệu đối tượng đâu nhé. ý của mình có thể hình dung như vầy : nếu có file text chứa stt, tọa độ như là (stt x1 y1 x2 y2), khi trên bản vẽ trống trơn, đọc file đó vào xử lý (nhưng kg vẽ chúng ra cad), vẫn tìm đc đáp số. Cám ơn bác

Hề hề hề,
Không vẽ ra vẫn có thể dùng các công thức hình học giải tích để tính toán được các khoảng cách và so sánh. Tuy nhiên phải học lại lớp 11 đã.
Vậy nếu vẽ ra rồi sau đó xóa đi thì bác TrungNgamy có trao giải không hè????
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.

#44 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 September 2011 - 10:45 PM

Bác nào rãnh rỗi giải trí chút ha:
Cho 2 đường tròn c1, c2. Vẽ các đoạn tiếp tuyến với cả 2 đường tròn trên (Ôn lại HH tí :D)
Chúc các bác vui vẻ.


Cái này có dùng lisp không bác ^^ Nêu cách vẽ hay cách giải trên lisp, và giải thưởng ??
Nếu nêu cách vẽ thì bài sẽ được chuyển sang mục Đố vui bên Kỹ thuật CAD , khà khà ^^


Nhìn qua code của bác ... mình chẳng hiểu gì lắm vì mình chưa có kiến thức về vl. Hôm nào rãnh, bác viết thêm chút chút cho đúng nghĩa giải trí để anh em chứng thực một tý.
Nhưng bác nhớ đầu bài chỉ cho bác tọa độ của line và số thứ tự thôi đấy, bác kg thề dùng những hàm liên quan đến truy xuất dữ liệu đối tượng đâu nhé. ý của mình có thể hình dung như vầy : nếu có file text chứa stt, tọa độ như là (stt x1 y1 x2 y2), khi trên bản vẽ trống trơn, đọc file đó vào xử lý (nhưng kg vẽ chúng ra cad), vẫn tìm đc đáp số. Cám ơn bác


- Vẫn có thể dùng các công thức toán học để tính toán, nhưng, các đối tượng chỉ là Line, mà tốc độ Entmake Line thì khá nhanh, nếu số lượng tầm 100k Line thì cũng chỉ mất mấy giây thôi, tội gì không sử dụng thế lợi của các thực thể CAD ^^
Giải thuật thứ 2 có thể là về toán học. Nhưng, giả sử muốn đi chi tiết hơn, thì đáp án mẫu của bác, file dữ liệu, file kết quả .. đâu ạ ^^
- Đề bác hỏi giải thuật, nên e chỉ đưa ra cách thức thôi, nếu đúng thì e xin Thanks, sai thì lại ngồi hóng, chứ với ngần ấy thứ bác cung cấp thì để viết nổi nó cũng thành Viết LISP theo yêu cầu, hoặc Hỏi về LISP, hoặc Hướng dẫn Lập trình LISP rồi bác ơi, còn đâu gọi là giải trí nữa ^^

P/S : đã tìm ra cách không dùng thực thể CAD. Chờ bác TrungNgaMy đưa ra file dữ liệu làm thử ^^
  • 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


#45 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 September 2011 - 10:47 PM

Đáp án đây bạn :


(defun c:gdcl nil
(new_dialog "LispEd" (load_dialog "acad.dcl"))
(set_tile "contents" "Goi hop thoai can 4 dong code lisp")
(start_dialog)
)

Cám ơn bác, đáp án của bác là gần phương án của em nhất. Xin tặng bác 3 dấu Thanks ^^
Thực ra, để gọi và thao tác với hộp thoại này, ta chỉ cần 1 dòng thôi :hàm LispED
(lisped "C\U+1EA7n 1 d\U+00F2ng !")
Hàm trả về text trong hộp thoại nếu nhấn OK, 0 nếu nhấn Cancel hoặc Esc và -1 nếu ấn Full Editor

Update : Đã thanks xong 2 ngày của bác gia_bach (tính là 8 nháy) và 3 nháy của bác Tuệ ^^ Mọi người ra đề dễ dễ để em kiếm tí nào ^^
  • 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


#46 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 September 2011 - 08:52 AM

Cám ơn bác, đáp án của bác là gần phương án của em nhất. Xin tặng bác 3 dấu Thanks ^^
Thực ra, để gọi và thao tác với hộp thoại này, ta chỉ cần 1 dòng thôi :hàm LispED
(lisped "C\U+1EA7n 1 d\U+00F2ng !")
Hàm trả về text trong hộp thoại nếu nhấn OK, 0 nếu nhấn Cancel hoặc Esc và -1 nếu ấn Full Editor

Update : Đã thanks xong 2 ngày của bác gia_bach (tính là 8 nháy) và 3 nháy của bác Tuệ ^^ Mọi người ra đề dễ dễ để em kiếm tí nào ^^

Thực ra là Ketxu "lừa" thiên hạ thôi. Chứ có rất nhiều cách gọi dialoge bằng chỉ 1 dòng (tức 1 hàm) như Ketxu. Lý do là các hàm này đã lập sẵn trong 1 số file của cad (VD: acad200x.lsp ...). Đáp án của bác Tue_NV là chuẩn. Câu đố này "sao sao ấy", nhưng xét về mặt "đố cho vui" thì cũng vui.
Thân thương!
P/S: nói thêm để đỡ tốn đất: tôi không hề trách Ket đâu, chỉ là vui thôi mà, hơn nữa cũng thêm 1 thông tin để mọi người biết: có 1 số hàm được lập sẵn trong cad để gọi dialoge chỉ bằng 1 dòng (tức 1 hàm). Dù biết vậy nhưng chính tôi cũng bị Ket lừa đấy. Hì, hì, hì!!!
  • 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.


#47 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 14 September 2011 - 04:06 PM


Cái này có dùng lisp không bác ^^ Nêu cách vẽ hay cách giải trên lisp, và giải thưởng ??
Nếu nêu cách vẽ thì bài sẽ được chuyển sang mục Đố vui bên Kỹ thuật CAD , khà khà ^^




- Vẫn có thể dùng các công thức toán học để tính toán, nhưng, các đối tượng chỉ là Line, mà tốc độ Entmake Line thì khá nhanh, nếu số lượng tầm 100k Line thì cũng chỉ mất mấy giây thôi, tội gì không sử dụng thế lợi của các thực thể CAD ^^
Giải thuật thứ 2 có thể là về toán học. Nhưng, giả sử muốn đi chi tiết hơn, thì đáp án mẫu của bác, file dữ liệu, file kết quả .. đâu ạ ^^
- Đề bác hỏi giải thuật, nên e chỉ đưa ra cách thức thôi, nếu đúng thì e xin Thanks, sai thì lại ngồi hóng, chứ với ngần ấy thứ bác cung cấp thì để viết nổi nó cũng thành Viết LISP theo yêu cầu, hoặc Hỏi về LISP, hoặc Hướng dẫn Lập trình LISP rồi bác ơi, còn đâu gọi là giải trí nữa ^^

P/S : đã tìm ra cách không dùng thực thể CAD. Chờ bác TrungNgaMy đưa ra file dữ liệu làm thử ^^

Mình gởi các bạn cái file để tạo dữ liệu trước. Dữ liệu thực gấp nhiều lần như thế. Bây giờ mình bận tí việc, khi quay lại mình sẽ viết code tạo danh sách ban đầu. Mình nghĩ cái này cũng tương tự như của Ketxu. Có một danh sách dữ liệu tọa độ 2 đầu từng cạnh. cung cấp một điểm bất kỳ, hãy trả về list vị trí của một hay các đoạn thẳng gần điểm cung cấp trong danh sách trên
http://www.cadviet.c...linegandiem.rar
  • 0

#48 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 14 September 2011 - 06:12 PM

Mình kg đưa đề tài này vào các yêu cầu về Lisp vì mình kg có ý định nhờ các bạn viết cái này cho đến khi thấy mục "đố vui" nên mình đưa lên "đố cho vui".
Vế cách viết vận dụng lợi thế của cad mình đã viết trên ARX thời cad14 rồi, thấy cũng có những bất tiện.
Cách viết chỉ căn cứ vào dữ liệu tọa độ mình đã viết trên delphi (trả kết quả về cad) với một số giải pháp nhưng vẫn chưa có thời gian kiểm tra nhiều.
Do Lisp kg có kiểu con trỏ và kiểu danh sách của Lisp hơi cứng nhắc nên ngoài cách viết tuần tự mình chưa nghĩ ra cách khác.
Sau đây là hàm tạo danh sách, mình viết trên lisp. các bạn rành vl có thể viết hay hơn :

(defun dxf( name n)
(cdr (assoc n (entget name)))
)
(defun taodanhsach( / ss i p1 p2)
(setq ss (ssget "x" '((0 . "line"))))
(if ss (progn
(setq i 0 l (sslength ss))
(while (< i l)
(setq name (ssname ss i))
(setq p1 (dxf name 10) p2 (dxf name 11))
(setq lst (append lst (list (list p1 p2))))
(setq i (1+ i))
)
))
lst
)

Từ danh sách ban đầu đó (chỉ có ý nghĩa minh họa), các bạn chế biến sao cho đc như yêu cầu
  • 0

#49 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 September 2011 - 06:25 PM

@bác TrungNgaMy : Thật lạ là bác dùng hàm taodanhsach để chọn tập chọn Line -> xuất ra file dữ liệu -> dùng đoạn lisp khác để đọc dữ iệu từ file xuất ra, tính toán và trả về kết quả, trong khi ngay từ bước duyệt qua đối tượng đã có thể tính toán luôn được rồi ^^.Có thể bác còn dùng file dữ liệu đó để làm việc khác, bằng chương trình khác, ngôn ngữ khác ^^.... Thôi không xét đến vấn đề tại sao có list, ta cứ làm 1 hàm kiểm tra khoảng cách điểm đến đường thẳng (khoảng cách theo định nghĩa của bác), với 3 đối số là (p1 p2 p3) (p1 p2 là 2 đầu, p3 là point kiểm tra). Còn bước so sánh nó với các khoảng cách khác thì vẫn vậy thôi ^^.
Đêm về e thử viết 2 hàm (1 : tạo đối tượng, 2 : không tạo đối tượng) để bác Test và so sánh tốc độ xem sao
  • 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


#50 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 September 2011 - 06:33 PM

Thực ra là Ketxu "lừa" thiên hạ thôi. Chứ có rất nhiều cách gọi dialoge bằng chỉ 1 dòng (tức 1 hàm) như Ketxu. Lý do là các hàm này đã lập sẵn trong 1 số file của cad (VD: acad200x.lsp ...). Đáp án của bác Tue_NV là chuẩn. Câu đố này "sao sao ấy", nhưng xét về mặt "đố cho vui" thì cũng vui.
Thân thương!
P/S: nói thêm để đỡ tốn đất: tôi không hề trách Ket đâu, chỉ là vui thôi mà, hơn nữa cũng thêm 1 thông tin để mọi người biết: có 1 số hàm được lập sẵn trong cad để gọi dialoge chỉ bằng 1 dòng (tức 1 hàm). Dù biết vậy nhưng chính tôi cũng bị Ket lừa đấy. Hì, hì, hì!!!

Em mắc tội chi với bác hoặc mọi người trên diễn đàn để đáng hay k đáng bị trách ạ ? Tội lừa bịp ạ ???
He, vốn em vẫn còn, mà đọc cm này không dám múa rìu nữa, bị mắng chết ^^
P/S thêm để đỡ tốn đất : em rất thích biết thêm nhiều thứ, bác ĐVH cứ đố vài câu về các hàm lập sẵn trong CAD đó để mọi người cùng giải trí nào ^^
  • 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


#51 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 14 September 2011 - 06:41 PM

@bác TrungNgaMy : Thật lạ là bác dùng hàm taodanhsach để chọn tập chọn Line -> xuất ra file dữ liệu -> dùng đoạn lisp khác để đọc dữ iệu từ file xuất ra, tính toán và trả về kết quả, trong khi ngay từ bước duyệt qua đối tượng đã có thể tính toán luôn được rồi ^^.Có thể bác còn dùng file dữ liệu đó để làm việc khác, bằng chương trình khác, ngôn ngữ khác ^^.... Thôi không xét đến vấn đề tại sao có list, ta cứ làm 1 hàm kiểm tra khoảng cách điểm đến đường thẳng (khoảng cách theo định nghĩa của bác), với 3 đối số là (p1 p2 p3) (p1 p2 là 2 đầu, p3 là point kiểm tra). Còn bước so sánh nó với các khoảng cách khác thì vẫn vậy thôi ^^.
Đêm về e thử viết 2 hàm (1 : tạo đối tượng, 2 : không tạo đối tượng) để bác Test và so sánh tốc độ xem sao

Do cái danh sách đó kg phải dùng 1 lần rồi bỏ, nên tạo danh sách trước và dùng dài dài trong quá trình chạy cad. Mỗi lần tạo lại danh sách rất lâu
  • 0

#52 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 September 2011 - 09:20 PM

2 hàm của bác đây : (p1 ,p2, p3 là các tọa độ WCS)
Hàm 1 (tham khảo) : Dựng đối tượng trước rồi lấy khoảng cách :

;Lay khoang cach ngan nhat tu 1 diem den bao doan thang
(defun pd1 (p1 p2 pt / dis ent)
;@Ketxu
(setq dis (distance pt (vlax-curve-getClosestPointTo (vlax-ename->vla-object
(setq ent (entmakex (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)(cons 60 1))))) pt)))
(entdel ent)
dis
)

- Hàm 2 : sử dụng trans, không dựng đối tượng :

(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
nm (mapcar '- p1 p2)
p1_ (trans p1 0 nm)
p2_ (trans p2 0 nm)
pt_ (trans pt 0 nm)
p1_x(abs (caddr p1_))
p2_x (abs(caddr p2_))
pt_x (abs(caddr pt_))
min_x (min p1_x p2_x)
max_x (max p1_x p2_x)
dis (cond ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
)
)
dis
)
Thông thường hàm 2 sẽ nhanh hơn hàm 1 khoảng 10 lần ^^
  • 2

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


#53 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 15 September 2011 - 09:22 AM

2 hàm của bác đây : (p1 ,p2, p3 là các tọa độ WCS)
.............
- Hàm 2 : sử dụng trans, không dựng đối tượng :


(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
nm (mapcar '- p1 p2)
p1_ (trans p1 0 nm)
p2_ (trans p2 0 nm)
pt_ (trans pt 0 nm)
p1_x(abs (caddr p1_))
p2_x (abs(caddr p2_))
pt_x (abs(caddr pt_))
min_x (min p1_x p2_x)
max_x (max p1_x p2_x)
dis (cond ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
)
)
dis
)
Thông thường hàm 2 sẽ nhanh hơn hàm 1 khoảng 10 lần ^^

Thanks Ketxu đã giới thiệu 1 ph/pháp mới (sử dụng trans) để tính toán.

Nhưng "hình như" sử dụng các tính toán cơ bản vẫn nhanh hơn sử dụng hàm của CAD (LISP) ??
Các bạn thử test hàm duới xem nhé. Thông thường sẽ nhanh hơn hàm trans khoảng 2 lần ^^
Thuật toán :
- Tính diện tích tam giác
- Tính đường cao
- k/tra chân đuờng cao nằm trong hay ngoài cạnh đáy
-> kết quả

(defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
;; @Gia_Bach
(defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
(setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
(if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001)) )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
(if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
(setq res (list dis1 sta))
(setq res (list dis2 end)) ) )
res)

  • 2

#54 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 September 2011 - 09:41 AM

Chính xác là em thích tính toán như cách bác gia_bach giới thiệu hơn (#44), và phải thú nhận là hiện giờ em đã quên hết các công thức hình học rồi :D, nên dù có nhắc tới cũng đành lờ đi :D
Diện tích tam giác chỉ nhớ mỗi chiều cao*đáy / 2 (hơi xấu hổ tí ^^)
Cảm ơn bác gia_bach 1 lầ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


#55 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 15 September 2011 - 10:36 AM

Cám ơn Ketxu và Giabach.
Vì đây là mục đố vui, mình nghĩ các bạn nên viết luôn phần còn lại để có thể chạy thử xem tốc độ thế nào. Vì phần còn lại còn phải so sánh kết quả kiểm tra với tất cả các đoạn thẳng và đưa ra danh sách vị trí các đoạn thẳng đc chọn. Căn cứ vào vị trí đó và đổi màu line đc chọn để xem kết quả có đúng line gần nhất kg.
Phần còn lại mình viết cũng đc nhưng đây đang KT tốc độ nên các bạn viết luôn đi. Tuy hơi chậm nhưng mình cũng sẽ viết một cái trên lisp để thử
  • 0

#56 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 15 September 2011 - 10:43 AM

..............
Nhưng "hình như" sử dụng các tính toán cơ bản vẫn nhanh hơn sử dụng hàm của CAD (LISP) ??
Các bạn thử test hàm duới xem nhé. Thông thường sẽ nhanh hơn hàm trans khoảng 2 lần ^^
.........

Xin đính chính một chút.
Sau khi k/tra kết quả chỉ nhanh hơn khoảng 1.5 lần.

Nhưng việc sử dụng cho k/quả không ổn định ?!

Command: TEST pick p1 :
pick p2 :
pick pt :
pd2 : 110
GetDis : 140
pd2 : 235
GetDis : 156
pd2 : 234
GetDis : 157
pd2 : 234
GetDis : 156
pd2 : 235
GetDis : 140

;..................
pd2 : 328
GetDis : 188
pd2 : 359
GetDis : 172
pd2 : 360
GetDis : 187
pd2 : 375
GetDis : 172
pd2 : 359
GetDis : 188

;..................
pd2 : 110
GetDis : 140
pd2 : 235
GetDis : 140
pd2 : 235
GetDis : 140
pd2 : 219
GetDis : 141
pd2 : 250
GetDis : 140


(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq nm (mapcar '- p1 p2)
p1_ (trans p1 0 nm)
p2_ (trans p2 0 nm)
pt_ (trans pt 0 nm)
p1_x (abs (caddr p1_))
p2_x (abs(caddr p2_))
pt_x (abs(caddr pt_))
min_x (min p1_x p2_x)
max_x (max p1_x p2_x)
dis (cond
((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_)))) ))
dis)[/i]
[i](defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
;; @Gia_Bach
(defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
(setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
(if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001)) )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
(if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
(setq res (list dis1 sta))
(setq res (list dis2 end)) ) )
res)[/i]
[i](defun c:test(/ count p1 p2 pt start)
(setq p1 (getpoint "pick p1 : ")
p2 (getpoint p1 "\npick p2 : ")
pt (getpoint p2 "\npick pt : ")
Count 10000)
(setq Start (getvar "Millisecs"))
(repeat Count
(pd2 p1 p2 pt) )
(princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))

(setq Start (getvar "Millisecs"))
(repeat Count
(GetDis p1 p2 pt) )
(princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i]
[i] (setq Start (getvar "Millisecs"))
(repeat Count
(pd2 p1 p2 pt) )
(princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i][i] (setq Start (getvar "Millisecs"))
(repeat Count
(GetDis p1 p2 pt) )
(princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i]
[i] (setq Start (getvar "Millisecs"))
(repeat Count
(pd2 p1 p2 pt) )
(princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))

(setq Start (getvar "Millisecs"))
(repeat Count
(GetDis p1 p2 pt) )
(princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i][i] (setq Start (getvar "Millisecs"))
(repeat Count
(pd2 p1 p2 pt) )
(princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i]
[i] (setq Start (getvar "Millisecs"))
(repeat Count
(GetDis p1 p2 pt) )
(princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))[/i][i] (setq Start (getvar "Millisecs"))
(repeat Count
(pd2 p1 p2 pt) )
(princ "\n pd2 : ")(princ (- (getvar "Millisecs") Start))[/i]
[i] (setq Start (getvar "Millisecs"))
(repeat Count
(GetDis p1 p2 pt) )
(princ "\n GetDis : ")(princ (- (getvar "Millisecs") Start))

(textscr)(princ ))

  • 0

#57 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 September 2011 - 11:32 AM

Nhanh hơn là tuyệt rồi bác ơi ^^
@bác TrungNgaMy : thực chất bác đang muốn làm việc gì đây ạ ? Theo yêu cầu của bác thì chưa có Line đâu ^^
Theo em thì có thể làm nhanh thế này :
List dữ liệu ban đầu :
lstPnt : (setq lstPnt (list (list p1 p2)(list p3 p4)(list p5 p6).....))
pt : point check
Hàm check của bác gia_bach e sửa dạng kết quả trả về (để ôm luôn dữ liệu đoạn thẳng theo ^^, như thế này hàm chậm đi tẹo nữa)

(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
;; @Gia_Bach
(defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
(setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
(if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001)) )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
(if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
(setq res (list dis1 (list sta end)))
(setq res (list dis2 (list sta end))))
)
res)

Cuối cùng là vẽ Line gần Point nhất từ dữ liệu :

(defun test (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(pd3 (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 100)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))
Việc nhanh hay chậm còn phụ thuộc vào kiểu xuất dữ liệu, kiểu kết quả muốn trả về, do vậy câu đố của bác Trung đúng là trăm cửa đi :)
Bác test kết quả 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


#58 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 15 September 2011 - 11:49 AM

Mình viết hàm để chạy hai cái hàm của Ketxu và Giabach cung cấp :

(defun dxf( name n)
(cdr (assoc n (entget name)))
)
(defun taodanhsach( / i p1 p2 lst)
(setq ssss (ssget "x" '((0 . "line"))))
(if ssss (progn
(setq i 0 l (sslength ssss))
(while (< i l)
(setq name (ssname ssss i))
(setq p1 (dxf name 10) p2 (dxf name 11))
(setq lst (append lst (list (list p1 p2))))
(setq i (1+ i))
)
))
lst
)
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=53705&pid=168615&st=40&#entry168615
(defun GetDis (sta end pt / dis1 dis2 len res dt chcao pt0)
;; @Gia_Bach
(defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
(setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
(if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001)) )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
(if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
(setq res (list dis1 sta))
(setq res (list dis2 end)) ) )
res)
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=53705&pid=168615&st=40&#entry168615
(defun pd2 (p1 p2 pt / p1_ p2_ pt_ p1_x p2_x pt_x dis)
;@Ketxu
(setq
nm (mapcar '- p1 p2)
p1_ (trans p1 0 nm)
p2_ (trans p2 0 nm)
pt_ (trans pt 0 nm)
p1_x(abs (caddr p1_))
p2_x (abs(caddr p2_))
pt_x (abs(caddr pt_))
min_x (min p1_x p2_x)
max_x (max p1_x p2_x)
dis (cond ((< pt_x min_x)(distance p1_ pt_))
((> pt_x max_x)(distance p2_ pt_))
(T (abs (-(car p1_)(car pt_))))
)
)
dis
)
(defun timdtgd_gb( p lst / len lst1 i l len len0 p1 p2 dt)
(setq i 0 len0 1000000.0 l (length lst))
(while (< i l)
(setq dt (nth i lst) p1 (car dt) p2 (cadr dt))
(setq len (GetDis p1 p2 p))
(cond
((< len len0)
(setq len0 len lst1 (list i))
)
((= len len0)
(setq lst1 (append lst1 (list i)))
)
)
(setq i (1+ i))
)
lst1
)
(defun timdtgd_kx2( p lst / len lst1 i l len len0 p1 p2 dt)
(setq i 0 len0 1000000.0 l (length lst))
(while (< i l)
(setq dt (nth i lst) p1 (car dt) p2 (cadr dt))
(setq len (pd2 p1 p2 p))
(cond
((< len len0)
(setq len0 len lst1 (list i))
)
((= len len0)
(setq lst1 (append lst1 (list i)))
)
)
(setq i (1+ i))
)
lst1
)
(defun timdt_kx2( p / i lst1)
(setq lst1 (timdtgd_kx2 p lst))
lst1
)
(defun timdt_gb( p / i lst1)
(setq lst1 (timdtgd_gb p lst))
lst1
)
(defun c:timdtkx2(/ i lst1)
(if (null lst) (setq lst (taodanhsach)))
(setq p (getpoint "\Pick"))
(setq lst1 (timdt_kx2 p))
(foreach a lst1 (command "_.change" (ssname ssss a) "" "P" "c" 1 ""))
)
(defun c:timdtgb(/ i lst1)
(if (null lst) (setq lst (taodanhsach)))
(setq p (getpoint "\Pick"))
(setq lst1 (timdt_gb p))
(foreach a lst1 (command "_.change" (ssname ssss a) "" "P" "c" 1 ""))
)
, hàm của Ketxu thì chạy đc, nhưng hàm của Giabach thì báo lỗi,

Command: timdtgb
Pick; error: bad argument type for compare: (3564.59 (592058.0 1.18285e+006
0.0)) 1.0e+006

phiền bạn xem lại giúp. Thêm nữa, hàm test của bạn mình chưa hiểu.

@Ketxu : mình vừa đưa code lên thì thấy bài của bạn, cám ơn để mình xem.
Mình đưa ra bài toàn kg có đối tượng, nhưng muốn KT nó cũng cần có đối tg để tạo danh sách, trong giải thuật bạn chỉ dựa vào dữ liệu tọa độ và những hàm toán học để thao tác, sau khi trả về mình dựa vào đó xem kết quả có đúng kg và thời gian thế nào
  • 0

#59 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 15 September 2011 - 01:44 PM

Nhanh hơn là tuyệt rồi bác ơi ^^
@bác TrungNgaMy : thực chất bác đang muốn làm việc gì đây ạ ? Theo yêu cầu của bác thì chưa có Line đâu ^^
Theo em thì có thể làm nhanh thế này :
List dữ liệu ban đầu :
lstPnt : (setq lstPnt (list (list p1 p2)(list p3 p4)(list p5 p6).....))
pt : point check
Hàm check của bác gia_bach e sửa dạng kết quả trả về (để ôm luôn dữ liệu đoạn thẳng theo ^^, như thế này hàm chậm đi tẹo nữa)


(defun Getdis (sta end pt / dis1 dis2 len res dt chcao pt0)
;; @Gia_Bach
(defun len-area (a b c / p);Dien tich tam giac
(setq p (/ (+ a b c) 2))
(sqrt (* p (- p a) (- p B)(- p c)) ))
(setq dis1 (distance pt sta)
dis2 (distance pt end)
len (distance end sta)
dt (len-area dis1 dis2 len)
chcao (/ (* 2 dt ) len)
pt0 (polar pt (+ (/ pi 2)(angle sta end)) chcao) )
(if (not (or (equal (angle pt0 sta) (angle pt0 end) 0.0001)
(equal (angle sta pt0) (angle sta end) 0.0001)) )
(setq pt0 (polar pt (angle pt0 pt) chcao)))
(if (inters pt pt0 sta end t)
(setq res (list chcao pt0))
(if (< dis1 dis2)
(setq res (list dis1 (list sta end)))
(setq res (list dis2 (list sta end))))
)
res)

Cuối cùng là vẽ Line gần Point nhất từ dữ liệu :

(defun test (pt lstPnt / kq)
(setq kq (car (vl-sort (mapcar '(lambda(x)(pd3 (car x) (cadr x) pt)) lstPnt) '(lambda(x y)(< (car x)(car y))))))
(entmakex (list (cons 0 "LINE")(cons 62 100)(cons 10 (caadr kq))(cons 11 (cadadr kq)))))
Việc nhanh hay chậm còn phụ thuộc vào kiểu xuất dữ liệu, kiểu kết quả muốn trả về, do vậy câu đố của bác Trung đúng là trăm cửa đi :)
Bác test kết quả nhé

bác thiếu cái hàm pd3 nên chưa test đc

P/S Sau khi test, hàm của Ketxu có TH trả vể đoạn thẳng kg đúng (mình sẽ cụ thể hóa TH kg đúng và đưa lên để bạn xem) và hàm của Gia_bach có lẽ kq trả về hơi khác yêu cầu một chút nên chưa test đc. Mình nói lại cho rõ để có sự thống nhất .
- 1/ Từ các đối tượng line trong bản vẽ , sd câu lệnh (setq ssss (ssget "x" '((0 . "line"))))
biến ssss là toàn cục các bạn đừng xóa đi.
- 2/ Từ ssss tạo danh sách đại khái là lst = (list dt0 dt1 dt2 .... dti ..... dtn) với 0, 1, 2 .... i .....n là vị trí của đoạn thẳng trong ssss
và dti là danh sách tọa độ của một đọan thẳng (list p1 p2) (phần dữ liệu này các bạn có thể tự sáng tạo)
- 3/ Sau khi cung cấp một điểm, kq trả vể là vị trí của đoạn thẳng (hoặc một số đoạn thẳng gần điểm) trong lst (hoặc ... do các bạn đạo diễn)
và quan trọng nó cũng là vị trí đối tượng line trong ssss.
- 4/ Căn cứ vị trí line trong ssss, có thể tô đỏ line đc chọn để Kt kết quả
(Hàm của mình viết dựa vào các hàm của Ketxu và Gia_bach cung cấp theo dạng như vậy)
  • 0

#60 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 15 September 2011 - 01:50 PM

@bác TrungNM : bác chú ý những dòng này trong hàm của bác gia_bach :<pre class="cadvietlispcode">

(setq res (list chcao pt0))(if (< dis1 dis2) (setq res (list dis1 sta)) (setq res (list dis2 end)) ) ) res)

Có nghĩa là kết quả trả về của bác gia_bach bao gồm list khoảng cách + 1 tọa độ điểm nốiĐể chỉ lấy về khoảng cách bác hãy chủ động sửa code hàm Getdis thành

(setq res chcao)(if (< dis1 dis2) (setq res dis1) (setq res dis2))) res)

hoặc lấy cadr của kết quả thu về.</pre>
  • 2

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