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

Bạn nào có ý tưởng nào hay về thuật toán để giải quyết vấn đề này không ?

Bởi garupro , trong Lập trình khác

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

garupro    7

garupro
Đã đăng

Mình có hình minh họa như thế này.

 

11111.PNG

 

Yêu cầu như sau :

 Đường MN có Lbq là cố định. Ta phải chia đều sao cho diện tích W1= W2; W3= W4 bằng cách dịch MN sang trái or phải và PQ lên or xuống

Đường màu đỏ là Pline các đường khác đều là Line

Bạn nào có ý tưởng nào không tư vấn cho mình chút . cảm ơn các  bạn nhiều

 

 

  • 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

nguoi_co_doc    2

nguoi_co_doc
Đã đăng

Bạn ơi cho mình hỏi, đây là bài toán về điều phối đất phải không ?

Nếu thế thì theo như mình hiều w1+w2 là diện tích đắp, w3+w4 là phần đào. 

Yêu cầu điều phối là w1+w2 = w3+w4 chứ nhỉ ?

Hay bài toán của bạn đưa ra là phát triển từ bài toán điều phối đất này nhỉ ?

  • 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

lyky    126

lyky
Đã đăng

Câu hỏi của bác garupro thật khó!

Lúc trước trên diễn đàn mình có bài toán xác định đường thẳng chia một vùng kín (pline) thành 2 phần có diện tích theo một tỷ lệ định trước, trong bài toán ấy

Vùng Pline kín là cố định, tỷ lệ chia cho trước cố định

Đường thẳng thì có 2 loại:

1. Là chùm song song, tịnh tiến từ một đường cho trước - có phương cố định.

2. Là chùm đồng quy, xoay quanh một điểm cho trước - tâm quay cố định.

Như vậy, trong bài toán chỉ có một yếu tố "động" là đường thẳng di chuyển hoặc xoay!

Bài toán này đã được anh SSG giải quyết khi trước rồi.

 

Trong bài toán của bạn, có đến 2 nhóm "động" đồng thời: nhóm cặp đường song song bước cố định Lpq tịnh tiến theo phương ngang và đường điều phối tịnh tiến theo phương dọc - Điều kiện đặt ra là đồng thời thoả mãn: (w1 = w2) /\ (w3 = w4) Nên bài toán khó khăn lên rất nhiều!

 

@ garupro: Vote bạn - bài toán thật hay!

@ nguoi_co_doc: có lẽ là (w1+w3) = (w2+w4) như trên hình vẽ là tổng lượng đất đào bằng tổng lượng đất đắp!

  • 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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Đây là 1 bài toán hay.

Tôi đề xuất giải thuật như sau:

1). Cho MN di chuyển từ 1 điểm Mmin đến Mmax, theo 1 bước nhảy nào đó.

2). Cho PQ di chuyển từ 1 điểm Pmin đến Pmax, theo 1 bước nhảy.

3). Lặp 2 vòng lồng nhau >> tính 4 diện tích >> so sánh >> đạt y/c thì dừng.

Các trở ngại:

1). Nó chỉ giải gần đúng. Khi bước nhảy càng nhỏ thì càng chính xác nhưng tính càng chậm, và ngược lai.

2). Chỉ có máy mới kham nỗi chứ người không đủ can đảm thử 2 lặp lồng nhau.

Để tôi ngâm cứu xem.

  • 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

garupro    7

garupro
Đã đăng

Đây chỉ là 1 trường hợp đơn giản các bạn ah. Còn có trường hợp là đường PQ không chỉ cắt tại 2 điểm mà cắt tại nhiều điểm khi đó không chỉ có W1=W2, W3=W4 đâu mà còn W5=W6, W7=W8... khi đó xuất hiện thêm các đoạn MN khác nhau nằm trên hoặc dưới PQ. Nói thật đây là bài toán rất khó mình chưa tìm được cách giải nào mà vừa chính xác và đỡ tốn time , như bạn Doan Van Ha nói thì cái này phải nói là để tính xong rất tốn time luôn. Kiểu này chắc mình làm 2 cái nút một cái để dịc PQ lên xuống, 1 cái để dịch MN sang trai hoặc phải với bước nhảy do người dùng nhập vào. Chứ tự động hoàn toàn nghe có vẻ bất khả thi rùi

 

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

nataca    554

nataca
Đã đăng

có cách tìm "vùng trọng tâm" để giảm thời gian "mò". Lúc đầu cho sai số lớn, sau đó tìm được kết quả rồi thì lại "mò" trong vùng kết quả với sai số nhỏ hơn, tiếp tục như thế đến sai số đạt yêu cầu. Kiểu này chắc phải dùng đến thuật toán đệ quy với biến sai số thay đổi.

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

Doan Van Ha
Đã đăng

có cách tìm "vùng trọng tâm" để giảm thời gian "mò". Lúc đầu cho sai số lớn, sau đó tìm được kết quả rồi thì lại "mò" trong vùng kết quả với sai số nhỏ hơn, tiếp tục như thế đến sai số đạt yêu cầu. Kiểu này chắc phải dùng đến thuật toán đệ quy với biến sai số thay đổi.

Thông thường thì người ta mò dần dần đến vùng trọng tâm chứ nhỉ? Nhưng mò cũng cần phải có mẹo!

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

lyky    126

lyky
Đã đăng

Thật sự là bài toán rất khó!

 

Nếu xét về mặt toán học thuần túy, ta có thể gắn thêm hệ trục 2D, đường cong tích lũy là một đường cong xác định bằng một phương trình f(x;y), cho trước B (như vậy bài toán có 2 ẩn số: [1] là cao độ đường điều phối & [2] là hoành độ điểm M (nói là hoành độ N cũng được – vì 2 giá trị này liên đới theo B ) → Khi đó 3 đường thẳng là các đường đơn giản vì song song với hệ trục. Khi đó chúng ta có thể dùng kiến thức tích phân để xác định các diện tích và áp đặt chúng theo 2 điều kiện ban đầu: w1 = w2 /\ w3 = w4 → Rút ra hệ 2 phương trình (phù hợp với yêu cầu 2 ẩn số kể trên!).

 

Trong thực tế – làm sao mặt đất lại có thể “thông minh” tự nhiên nằm nghiệm đúng theo 1 đường cong trơn, có thể chỉ là một Pline → Từ Pline ta có thể hồi quy về một đường cong trơn (có thể áp dụng phương pháp bình phương cực tiểu độ lệch – nhưng nghe có vẻ xa vời quá!) Như vậy, về mặt toán học thuần túy – bài toán mang tính khả dĩ.

 

Nếu viết chương trình AutoLISP thì quả khó thật, tùy thuộc vào đường cong và tốc độ di chuyển (quét) của 2 chùm đường (phụ thuộc vào bước nhảy (move+offset) của từng nhóm), chưa chắc gì đã hội tụ, có khi nó trở thành một cuộc chạy đua, kẻ trước người sau cùng nhau vượt qua mốc mà nếu cùng gặp nhau tại đó bài toán có thể hội tụ, dấu hiệu nào để kẻ đi trước biết được mà quay đầu lại để bài toán hội tụ – khó quá!

Nhưng nếu Garupro có thể chấp nhận thế này thử:

 

1. Cho H cố định, nghĩa là đường điều phối xác định, nằm ngang cũng được (giả sử xiên cũng được).

2. Cho B biến đổi, để 2 đường thẳng qua M và N tự do di chuyển, không còn ràng buộc nhau bằng B.

 

Khi đó, bài toán có thể giải quyết được, tôi tạm gọi là phương pháp “dao động tắt dần”. Và chúng ta giải quyết bằng một cách chung cho cả 2 nhánh đường cong, như sau:

 

22665_h1.jpg

 

Giá trị nhập:

1. Nhánh đường cong có giới hạn.

2. Đoạn thẳng đại diện của chùm đường thẳng.

3. Hướng di chuyển và bước di chuyển đầu tiên.

4. Độ chính xác yêu cầu của kết quả.

 

Giải thuật sơ lược:

1. Viết một vòng lặp, trong đó ứng với mỗi bước đoạn thẳng di chuyển (tịnh tiến = move+offset) một bước: @ = i, tại mỗi vị trí xác định hiệu số: A = [s2 – S1] (vì theo hình vẽ đoạn thẳng di chuyển từ biên trái sang phải → ban đầu S2 > S1), vòng lặp chạy đến khi hiệu số A đổi dấu (từ + sang –), dừng vòng lặp.

2. Bắt đầu một vòng lặp mới, trong đó đoạn thẳng di chuyển theo hướng ngược lại hướng ban đầu với bước: @ = i/2, tại mỗi vị trí lại xác định hiệu số: A = [s2 – S1], vòng lặp chạy đến khi hiệu số A đổi dấu (từ – sang +), dừng vòng lặp.

3. Tiếp tục một vòng lặp mới với bước @ = i/4 , v.v...

4. Mãi đến khi hiệu số: A = [s2 – S1] < độ chính xác yêu cầu thì mặc nhiên dừng lại, in đoạn thẳng tại vị trí dừng ra màn hình. Đó chính là kết quả bài toán.

P/S: Vì biên độ di chuyển sau mỗi lần đảo chiều của đoạn thẳng luôn nhỏ hơn lần trước – Vì vậy nên tôi gọi là “dao động tắt dần”.

 

@ Vì không biết mục đích Garupro sử dụng LISP này vào trường hợp cụ thể nào – nên mình mạo muội – mong các bạn đừng cho là spam! Mời các Mem tiếp tục viết giúp bạn í!

  • Vote tăng 4

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

Doan Van Ha
Đã đăng

Lý luận của bạn rất khoa học và khá logic. Lâu rồi mới đọc được 1 bài viết "sướng". Tôi vote.

Tuy nhiên, có 1 điều này hình như bạn hơi nhầm: là không có chuyện Mỹ và Triều cùng chạy đua vũ trang để đến nỗi chiến tranh hạt nhân xãy ra.

Thuật toán của tôi là:

1). Mỹ chạy 1 bước, cho Triều chạy hết mọi nẽo, kiểm tra từng cặp chạy.

2). Mỹ chạy bước thứ 2, cho Triều chạy hết lại, kiểm tra.

...

n). Mỹ chạy bước cuối, Triều chạy như cũ, kiểm tra.

Trong quá trình chạy và kiểm tra, nếu đạt sai số cho phép thì dừng.

Tức là lặp trong lặp, chứ không phải 2 lặp song song!

Tôi chỉ phân vân 1 điều này thôi: là trong trường hợp tổng quát liệu nó có hội tụ không. Hiện đang viết và cũng đang tìm cách chứng minh nó hội tụ, chứ không thì... toi.

  • 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

hoanguct    0

hoanguct
Đã đăng

Thật sự là bài toán rất khó!

 

Nếu xét về mặt toán học thuần túy, ta có thể gắn thêm hệ trục 2D, đường cong tích lũy là một đường cong xác định bằng một phương trình f(x;y), cho trước B (như vậy bài toán có 2 ẩn số: [1] là cao độ đường điều phối & [2] là hoành độ điểm M (nói là hoành độ N cũng được – vì 2 giá trị này liên đới theo B ) → Khi đó 3 đường thẳng là các đường đơn giản vì song song với hệ trục. Khi đó chúng ta có thể dùng kiến thức tích phân để xác định các diện tích và áp đặt chúng theo 2 điều kiện ban đầu: w1 = w2 /\ w3 = w4 → Rút ra hệ 2 phương trình (phù hợp với yêu cầu 2 ẩn số kể trên!).

 

Trong thực tế – làm sao mặt đất lại có thể “thông minh” tự nhiên nằm nghiệm đúng theo 1 đường cong trơn, có thể chỉ là một Pline → Từ Pline ta có thể hồi quy về một đường cong trơn (có thể áp dụng phương pháp bình phương cực tiểu độ lệch – nhưng nghe có vẻ xa vời quá!) Như vậy, về mặt toán học thuần túy – bài toán mang tính khả dĩ.

 

Nếu viết chương trình AutoLISP thì quả khó thật, tùy thuộc vào đường cong và tốc độ di chuyển (quét) của 2 chùm đường (phụ thuộc vào bước nhảy (move+offset) của từng nhóm), chưa chắc gì đã hội tụ, có khi nó trở thành một cuộc chạy đua, kẻ trước người sau cùng nhau vượt qua mốc mà nếu cùng gặp nhau tại đó bài toán có thể hội tụ, dấu hiệu nào để kẻ đi trước biết được mà quay đầu lại để bài toán hội tụ – khó quá!

Nhưng nếu Garupro có thể chấp nhận thế này thử:

 

1. Cho H cố định, nghĩa là đường điều phối xác định, nằm ngang cũng được (giả sử xiên cũng được).

2. Cho B biến đổi, để 2 đường thẳng qua M và N tự do di chuyển, không còn ràng buộc nhau bằng B.

 

Khi đó, bài toán có thể giải quyết được, tôi tạm gọi là phương pháp “dao động tắt dần”. Và chúng ta giải quyết bằng một cách chung cho cả 2 nhánh đường cong, như sau:

 

22665_h1.jpg

 

Giá trị nhập:

1. Nhánh đường cong có giới hạn.

2. Đoạn thẳng đại diện của chùm đường thẳng.

3. Hướng di chuyển và bước di chuyển đầu tiên.

4. Độ chính xác yêu cầu của kết quả.

 

Giải thuật sơ lược:

1. Viết một vòng lặp, trong đó ứng với mỗi bước đoạn thẳng di chuyển (tịnh tiến = move+offset) một bước: @ = i, tại mỗi vị trí xác định hiệu số: A = [s2 – S1] (vì theo hình vẽ đoạn thẳng di chuyển từ biên trái sang phải → ban đầu S2 > S1), vòng lặp chạy đến khi hiệu số A đổi dấu (từ + sang –), dừng vòng lặp.

2. Bắt đầu một vòng lặp mới, trong đó đoạn thẳng di chuyển theo hướng ngược lại hướng ban đầu với bước: @ = i/2, tại mỗi vị trí lại xác định hiệu số: A = [s2 – S1], vòng lặp chạy đến khi hiệu số A đổi dấu (từ – sang +), dừng vòng lặp.

3. Tiếp tục một vòng lặp mới với bước @ = i/4 , v.v...

4. Mãi đến khi hiệu số: A = [s2 – S1] < độ chính xác yêu cầu thì mặc nhiên dừng lại, in đoạn thẳng tại vị trí dừng ra màn hình. Đó chính là kết quả bài toán.

P/S: Vì biên độ di chuyển sau mỗi lần đảo chiều của đoạn thẳng luôn nhỏ hơn lần trước – Vì vậy nên tôi gọi là “dao động tắt dần”.

 

@ Vì không biết mục đích Garupro sử dụng LISP này vào trường hợp cụ thể nào – nên mình mạo muội – mong các bạn đừng cho là spam! Mời các Mem tiếp tục viết giúp bạn í!

 

Thật sự là bài toán rất khó!

 

Nếu xét về mặt toán học thuần túy, ta có thể gắn thêm hệ trục 2D, đường cong tích lũy là một đường cong xác định bằng một phương trình f(x;y), cho trước B (như vậy bài toán có 2 ẩn số: [1] là cao độ đường điều phối & [2] là hoành độ điểm M (nói là hoành độ N cũng được – vì 2 giá trị này liên đới theo B ) → Khi đó 3 đường thẳng là các đường đơn giản vì song song với hệ trục. Khi đó chúng ta có thể dùng kiến thức tích phân để xác định các diện tích và áp đặt chúng theo 2 điều kiện ban đầu: w1 = w2 /\ w3 = w4 → Rút ra hệ 2 phương trình (phù hợp với yêu cầu 2 ẩn số kể trên!).

 

Trong thực tế – làm sao mặt đất lại có thể “thông minh” tự nhiên nằm nghiệm đúng theo 1 đường cong trơn, có thể chỉ là một Pline → Từ Pline ta có thể hồi quy về một đường cong trơn (có thể áp dụng phương pháp bình phương cực tiểu độ lệch – nhưng nghe có vẻ xa vời quá!) Như vậy, về mặt toán học thuần túy – bài toán mang tính khả dĩ.

 

Nếu viết chương trình AutoLISP thì quả khó thật, tùy thuộc vào đường cong và tốc độ di chuyển (quét) của 2 chùm đường (phụ thuộc vào bước nhảy (move+offset) của từng nhóm), chưa chắc gì đã hội tụ, có khi nó trở thành một cuộc chạy đua, kẻ trước người sau cùng nhau vượt qua mốc mà nếu cùng gặp nhau tại đó bài toán có thể hội tụ, dấu hiệu nào để kẻ đi trước biết được mà quay đầu lại để bài toán hội tụ – khó quá!

Nhưng nếu Garupro có thể chấp nhận thế này thử:

 

1. Cho H cố định, nghĩa là đường điều phối xác định, nằm ngang cũng được (giả sử xiên cũng được).

2. Cho B biến đổi, để 2 đường thẳng qua M và N tự do di chuyển, không còn ràng buộc nhau bằng B.

 

Khi đó, bài toán có thể giải quyết được, tôi tạm gọi là phương pháp “dao động tắt dần”. Và chúng ta giải quyết bằng một cách chung cho cả 2 nhánh đường cong, như sau:

 

22665_h1.jpg

 

Giá trị nhập:

1. Nhánh đường cong có giới hạn.

2. Đoạn thẳng đại diện của chùm đường thẳng.

3. Hướng di chuyển và bước di chuyển đầu tiên.

4. Độ chính xác yêu cầu của kết quả.

 

Giải thuật sơ lược:

1. Viết một vòng lặp, trong đó ứng với mỗi bước đoạn thẳng di chuyển (tịnh tiến = move+offset) một bước: @ = i, tại mỗi vị trí xác định hiệu số: A = [s2 – S1] (vì theo hình vẽ đoạn thẳng di chuyển từ biên trái sang phải → ban đầu S2 > S1), vòng lặp chạy đến khi hiệu số A đổi dấu (từ + sang –), dừng vòng lặp.

2. Bắt đầu một vòng lặp mới, trong đó đoạn thẳng di chuyển theo hướng ngược lại hướng ban đầu với bước: @ = i/2, tại mỗi vị trí lại xác định hiệu số: A = [s2 – S1], vòng lặp chạy đến khi hiệu số A đổi dấu (từ – sang +), dừng vòng lặp.

3. Tiếp tục một vòng lặp mới với bước @ = i/4 , v.v...

4. Mãi đến khi hiệu số: A = [s2 – S1] < độ chính xác yêu cầu thì mặc nhiên dừng lại, in đoạn thẳng tại vị trí dừng ra màn hình. Đó chính là kết quả bài toán.

P/S: Vì biên độ di chuyển sau mỗi lần đảo chiều của đoạn thẳng luôn nhỏ hơn lần trước – Vì vậy nên tôi gọi là “dao động tắt dần”.

 

@ Vì không biết mục đích Garupro sử dụng LISP này vào trường hợp cụ thể nào – nên mình mạo muội – mong các bạn đừng cho là spam! Mời các Mem tiếp tục viết giúp bạn í!

giải thuật như thế của bạn như thế xem như là đã giải quyết được bại toán về mặt kĩ thuật. Tuy nhiên theo mình để giảm được quá trình tính toán nên bắt đầu xuất phát từ điểm giữa. Vì rỏ ràng điểm cần tìm nằm loanh quanh điểm này vì thông thường đường gấp khúc của chúng ta "tương đối" đối xứ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

ketxu    2.983

ketxu
Đã đăng

Ngon, đối xứng thì lấy mắt đặt vào đấy, nhìn cân cân là thịt thôi, có ai check lại được ^^

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

garupro    7

garupro
Đã đăng

Thật sự là bài toán rất khó!

 

Nếu xét về mặt toán học thuần túy, ta có thể gắn thêm hệ trục 2D, đường cong tích lũy là một đường cong xác định bằng một phương trình f(x;y), cho trước B (như vậy bài toán có 2 ẩn số: [1] là cao độ đường điều phối & [2] là hoành độ điểm M (nói là hoành độ N cũng được – vì 2 giá trị này liên đới theo B ) → Khi đó 3 đường thẳng là các đường đơn giản vì song song với hệ trục. Khi đó chúng ta có thể dùng kiến thức tích phân để xác định các diện tích và áp đặt chúng theo 2 điều kiện ban đầu: w1 = w2 /\ w3 = w4 → Rút ra hệ 2 phương trình (phù hợp với yêu cầu 2 ẩn số kể trên!).

 

Trong thực tế – làm sao mặt đất lại có thể “thông minh” tự nhiên nằm nghiệm đúng theo 1 đường cong trơn, có thể chỉ là một Pline → Từ Pline ta có thể hồi quy về một đường cong trơn (có thể áp dụng phương pháp bình phương cực tiểu độ lệch – nhưng nghe có vẻ xa vời quá!) Như vậy, về mặt toán học thuần túy – bài toán mang tính khả dĩ.

 

Nếu viết chương trình AutoLISP thì quả khó thật, tùy thuộc vào đường cong và tốc độ di chuyển (quét) của 2 chùm đường (phụ thuộc vào bước nhảy (move+offset) của từng nhóm), chưa chắc gì đã hội tụ, có khi nó trở thành một cuộc chạy đua, kẻ trước người sau cùng nhau vượt qua mốc mà nếu cùng gặp nhau tại đó bài toán có thể hội tụ, dấu hiệu nào để kẻ đi trước biết được mà quay đầu lại để bài toán hội tụ – khó quá!

Nhưng nếu Garupro có thể chấp nhận thế này thử:

 

1. Cho H cố định, nghĩa là đường điều phối xác định, nằm ngang cũng được (giả sử xiên cũng được).

2. Cho B biến đổi, để 2 đường thẳng qua M và N tự do di chuyển, không còn ràng buộc nhau bằng B.

 

Khi đó, bài toán có thể giải quyết được, tôi tạm gọi là phương pháp “dao động tắt dần”. Và chúng ta giải quyết bằng một cách chung cho cả 2 nhánh đường cong, như sau:

 

22665_h1.jpg

 

Giá trị nhập:

1. Nhánh đường cong có giới hạn.

2. Đoạn thẳng đại diện của chùm đường thẳng.

3. Hướng di chuyển và bước di chuyển đầu tiên.

4. Độ chính xác yêu cầu của kết quả.

 

Giải thuật sơ lược:

1. Viết một vòng lặp, trong đó ứng với mỗi bước đoạn thẳng di chuyển (tịnh tiến = move+offset) một bước: @ = i, tại mỗi vị trí xác định hiệu số: A = [s2 – S1] (vì theo hình vẽ đoạn thẳng di chuyển từ biên trái sang phải → ban đầu S2 > S1), vòng lặp chạy đến khi hiệu số A đổi dấu (từ + sang –), dừng vòng lặp.

2. Bắt đầu một vòng lặp mới, trong đó đoạn thẳng di chuyển theo hướng ngược lại hướng ban đầu với bước: @ = i/2, tại mỗi vị trí lại xác định hiệu số: A = [s2 – S1], vòng lặp chạy đến khi hiệu số A đổi dấu (từ – sang +), dừng vòng lặp.

3. Tiếp tục một vòng lặp mới với bước @ = i/4 , v.v...

4. Mãi đến khi hiệu số: A = [s2 – S1] < độ chính xác yêu cầu thì mặc nhiên dừng lại, in đoạn thẳng tại vị trí dừng ra màn hình. Đó chính là kết quả bài toán.

P/S: Vì biên độ di chuyển sau mỗi lần đảo chiều của đoạn thẳng luôn nhỏ hơn lần trước – Vì vậy nên tôi gọi là “dao động tắt dần”.

 

@ Vì không biết mục đích Garupro sử dụng LISP này vào trường hợp cụ thể nào – nên mình mạo muội – mong các bạn đừng cho là spam! Mời các Mem tiếp tục viết giúp bạn í!

 

Cảm ơn bạn theo cách của bạn thì đoạn MN sẽ không còn chiều dài cố định nữa, và đường điều phối mình phải tự vạch. Cách này thì trước đây mình có hỏi và hiện tại đã giải quyết được. Giờ mình muốn nó tự xác định cái đường PQ thỏa mãn 2 điều kiện W1=W2 ^ W3=W4 và MN không đổi cơ nhưng mình nghĩ là sẽ có trường hợp cả hai không hội tụ tại 1 điểm  vậy thử theo hướng khác xem : Là MN không cố định nữa mà có chiều dài phải <= 1 đoạn L nào đó (Do mình nhập) liệu có được không nhỉ. Còn nếu vẫn khó khăn thì ta phải xét đến trường hợp là người dùng tự kẻ đường PQ, sau đó tự phân chia W1=W2 ^ W3=W4 và thỏa mãn MN <= L như vậy bài toán chắc đơn giản hơn. Các bạn xem giúp mình. Thank

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

lyky    126

lyky
Đã đăng

Tôi chỉ phân vân 1 điều này thôi: là trong trường hợp tổng quát liệu nó có hội tụ không. Hiện đang viết và cũng đang tìm cách chứng minh nó hội tụ, chứ không thì... toi.

Dạ, cám ơn anh, anh giải thích thật tỷ mỹ, hôm trước anh đã nói là lồng vòng lặp mà tôi lại cứ hiểu nhầm chạy song song!

Bạn chủ thớt ơi, bác Hà bác ấy nói thế là bác đang cố gắng hoàn thành giúp bạn đấy - bạn kiên nhẫn chờ tý chứ đừng thêm điều kiện "bất định" cho bề rộng B - như thế có lẽ sẽ làm tăng thêm phức tạp mà thôi!

 

@ Spam tý: Chúc cả nhà ăn đám giổ 10.3 thật vui và thật hoành tráng nhé!

  • 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

Skywings    49

Skywings
Đã đăng

Một bài toán hay, lâu rùi mới có hứng thú lại với Lisp ^^. Đây là giải pháp của mình dựa trên thuật toán của các bác đưa ra, nếu viết có luộm thuộm các bác thông cảm :D . Chưa có thời gian test kỹ, các bác dùng thử nhé ^_^ .

* Lưu ý kích thước MN quá nhỏ so với PQ có thể gây ra lỗi xác định diện tích, nếu PQ có nhiều điểm cực tiểu, chương trình chỉ tính toán cho điểm điểm cực tiểu thấp nhất.

;; Skywings - Revised 240412
(vl-load-com)
(defun c:t1 (/           AREALST     ENDPNT       ENDPNTMN  FROMPNT
         FUZZ      I0     I1       I2         I3
         INTPNTS   IX     IY       LWP0         LWP1
         LWPENT    LWPOBJ     MN       MNDIST    MSPACE
         PNT0      PNT1     PQ       S0         S1
         S2           S3     STARTPNT  STARTPNTMN
         STARTPNTPQ         SUB01       SUB01NEW  SUB32
         SUB32NEW  THISDRAWING       TMPLWP    TOPNTX
         TOPNTY    MAXPOINT     MINPOINT  ISFLIPED  TMPLWPOBJ
         BOTPNT    MINMAXPNTS       TOPPNT    N
        )
  ;; Thiet lap
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace thisdrawing))
  (vla-startundomark thisdrawing)
  (setvar "CMDECHO" 0)
  (if (null MNdistSv)
    (setq MNdistSv 5)
  )
  (if (null fuzzSv)
    (setq fuzzSv 0.1)
  )
  ;; Du lieu dau vao
  (initget (+ 2 4))
  (setq    MNdist (getreal    (strcat    "\nXac dinh chieu dai MN: <"
                (rtos MNdistSv 2 2)
                ">"
            )
           )
  )
  (if (null MNdist)
    (setq MNdist MNdistSv)
    (setq MNdistSv MNdist)
  )
  (initget (+ 2 4))
  (setq    fuzz (getreal (strcat "\nXac dinh do chinh xac dien tich: <"
                  (rtos fuzzSv 2 2)
                  ">"
              )
         )
  )
  (if (null fuzz)
    (setq fuzz fuzzSv)
    (setq fuzzSv fuzz)
  )
  (while (null
       (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
     )
    (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
  )
  (setq lwpObj (vlax-ename->vla-object lwpEnt))
  (setq    startPnt (vlax-curve-getStartPoint lwpObj)
    endPnt     (vlax-curve-getEndPoint lwpObj)
  )
  ;; Kiem tra diem cuc tieu
  (setq MinMaxPnts (LM:CurveMinMax lwpObj 1e-8))
  (setq    TopPnt (cadr MinMaxPnts)
    BotPnt (car MinMaxPnts)
  )
  (if (or (equal (distance BotPnt startPnt) 0.0 0.01)
      (equal (distance BotPnt endPnt) 0.0 0.01)
      )
    (progn
      (setq tmpLwpObj (vla-mirror
            lwpObj
            (vlax-3d-point startPnt)
            (vlax-3d-point (polar startPnt 0 0.1))
              )
              ;; lat bung
      )
      (vla-delete lwpObj)
      (setq lwpObj   tmpLwpObj
        isFliped 1
      )
      (setq startPnt (vlax-curve-getStartPoint lwpObj)
        endPnt   (vlax-curve-getEndPoint lwpObj)
      )
    )
  )
  (vla-GetBoundingBox lwpObj 'minpoint 'maxpoint)
  (vla-ZoomWindow (vlax-get-acad-object) minpoint maxpoint)
  ;; Xac dinh duong PQ
  (if (< (cadr startPnt) (cadr endPnt))
    (setq startPntPQ startPnt)
    (setq startPntPQ endPnt)
  )
  (setq    tmpLwp (AddLwpolyline
         (list startPntPQ (polar startPntPQ 0 1))
         0
         mspace
           )
  )
  (setq intPnts (LM:Intersections tmpLwp lwpObj acExtendThisEntity))
  (if (> (length intPnts) 1)
    (setq PQ (AddLwpolyline intPnts 0 mspace))
    (progn
      (vla-delete tmpLwp)
      (reset)
      (exit)
    )
  )
  (vla-delete tmpLwp)
  ;; Chieu dai doan MN
  (if (= isFliped 1)
    (setq BotPnt (car (LM:CurveMinMax lwpObj 1e-8)))
  )
  (setq    startPntMN (polar BotPnt pi (/ MNdist 2))
    endPntMN   (polar BotPnt 0 (/ MNdist 2))
  )
  (setq MN (AddLwpolyline (list startPntMN endPntMN) 0 mspace))
  ;; Xac dinh 2 duong giong tu MN den PQ
  (setq    pnt0 (vlax-curve-getClosestPointTo PQ startPntMN)
    pnt1 (vlax-curve-getClosestPointTo PQ endPntMN)
  )
  (setq    lwp0 (AddLwpolyline (list startPntMN pnt0) 0 mspace)
    lwp1 (AddLwpolyline (list endPntMN pnt1) 0 mspace)
  )
  ;; Kiem tra dien tich
  (setq AreaLst (CalArea (list pnt0 startPntMN endPntMN pnt1) lwpObj))
  (setq    s0 (nth 0 AreaLst)
    s1 (nth 1 AreaLst)
    s2 (nth 2 AreaLst)
    s3 (nth 3 AreaLst)
  )
  (if (and (< s0 s1)
       (< s3 s2)
      )
    (progn
      (alert "Khong the dieu chinh!")
      (reset)
      (exit)
    )
  )
  ;; Can bang so bo 1 cap dien tich
  (textscr)
  (setq iY (- 0 (/ (distance startPntMN pnt0) 20)))
                    ; buoc nhay phuong doc
  (setq    FromPnt    (vlax-3d-point pnt0)
    ToPntY    (vlax-3d-point (polar pnt0 (/ pi 2) iY))
  )
  (while (and (>= (nth 0 AreaLst) (nth 1 AreaLst))
          (>= (nth 3 AreaLst) (nth 2 AreaLst))
     )
    (vla-move PQ FromPnt ToPntY)
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
      pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq AreaLst (CalArea (list pnt0 startPntMN endPntMN pnt1) lwpObj))
  )
  (if (> (- (nth 0 AreaLst) (nth 1 AreaLst))
     (- (nth 3 AreaLst) (nth 2 AreaLst))
      )
    (setq i0 3
      i1 2
      i2 1
      i3 0
    )
    (setq i0 0
      i1 1
      i2 2
      i3 3
    )
  )
  (setq n 0)
  (setq sub32 (- (nth i3 AreaLst) (nth i2 AreaLst)))
  ;; Can bang dien tich dua tren dich chuyen PQ
  (while (not (equal (nth i3 AreaLst) (nth i2 AreaLst) fuzz))
    (if    (> n 100) ;; Gioi han so vong lap
      (progn
    (alert "Vuot qua gioi han 100 lan thu!")
    (reset)
    (exit)
      )
    )
    (vla-move PQ
          (vlax-3d-point pnt0)
          (vlax-3d-point (polar pnt0 (/ pi 2) iY))
    )
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
      pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq iX (/ MNdist 20.00))            ; buoc nhay phuong ngang
    (setq AreaLst (reverse (CalArea (list pnt0 startPntMN endPntMN pnt1) lwpObj)))
    (setq sub01    (- (nth i0 AreaLst) (nth i1 AreaLst)))
    (setq FromPnt (vlax-3d-point pnt0)
      ToPntX  (vlax-3d-point (polar pnt0 0 iX))
    )
    ;; Can bang dien tich dua tren dich chuyen MN
    (while (> (abs sub01) (abs sub32))
      (vla-move MN FromPnt ToPntX)
      (vla-move lwp0 FromPnt ToPntX)
      (vla-move lwp1 FromPnt ToPntX)
      (setq pnt0       (polar pnt0 0 iX)
        pnt1       (polar pnt1 0 iX)
        startPntMN (polar startPntMN 0 iX)
        endPntMN   (polar endPntMN 0 iX)
      )
      (setq AreaLst (reverse (CalArea (list pnt0 startPntMN endPntMN pnt1) lwpObj)))
      (setq sub01new (- (nth i0 AreaLst) (nth i1 AreaLst)))
      (if (> (abs sub01new) (abs sub01))
    (setq iX (/ (- 0 iX) 2))
      )
      (setq sub01 sub01new)
      (setq FromPnt (vlax-3d-point pnt0)
        ToPntX  (vlax-3d-point (polar pnt0 0 iX))
      )
    )
    (setq sub32new (- (nth i3 AreaLst) (nth i2 AreaLst)))
    (if    (> (abs sub32new) (abs sub32))
      (setq iY (/ (- 0 iY) 2))
    )
    (setq sub32 sub32new)
    (setq n (1+ n))
    (print AreaLst)
  )
  (vla-zoomprevious (vlax-get-acad-object))
  (reset)
  (princ)
)
(defun reset ()
  (if (= isFliped 1)
    (progn
      (foreach obj (list lwpObj MN PQ lwp0 lwp1)
    (vla-mirror
      obj
      (vlax-3d-point startPnt)
      (vlax-3d-point (polar startPnt 0 0.1))
    )
    (vla-delete obj)
      )
    )
  )
  (vla-endundomark thisdrawing)
  (graphscr)
)

;; Sub function
(defun GetMidPnt (pt0 pt1 / midPnt)
  (setq    midPnt (list (/ (+ (car pt0) (car pt1)) 2)
             (/ (+ (cadr pt0) (cadr pt1)) 2)
             0
           )
  )
  midPnt
)
(defun CalArea (pntLst obj / AreaLst tmpLwp)
  (setq
    midPntLst (mapcar
        '(lambda (x)
           (GetMidPnt x (vlax-curve-getClosestPointTo obj x))
         )
        pntLst
          )
  )
  (foreach pt midPntLst
    (setq HdlEnt (cdr (assoc 5 (entget (entlast)))))
    (command ".boundary" pt "")
    (if    (/= HdlEnt (cdr (assoc 5 (entget (entlast)))))
      (progn
    (setq tmpLwp (vlax-ename->vla-object (entlast)))
    (setq AreaLst (cons (vlax-get-property tmpLwp 'AREA) AreaLst))
    (vla-delete tmpLwp)
      )
      (progn
    (alert "Khong the tao Boundary!")
    (reset)
    (exit)
      )
    )
  )
  AreaLst
)
(defun LM:Intersections    (obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
      l (cdddr l)
    )
  )
  (reverse r)
)

(defun AddLwpolyline (lst-pnt layer *model-space* / array-pt myPline)
  (setq    array-pt (list->variantArray
           (apply 'append (mapcar '3dPnt->2dPnt lst-pnt))
         )
    myPline     (vla-AddLightWeightPolyline *model-space* array-pt)
  )
  (vla-put-layer myPline layer)
  myPline
)

(defun list->variantArray (ptsList / arraySpace sArray)
  (setq    arraySpace
     (vlax-make-safearray
       vlax-vbdouble
       (cons 0
         (- (length ptsList) 1)
       )
     )
  )
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
  (vlax-make-variant sArray)
)

(defun 3dPnt->2dPnt (3dpt)
  (list (float (car 3dpt)) (float (cadr 3dpt)))
)

(defun LM:CurveMinMax
              (obj         fuzz       /
               _GetBoundingBoxWithOffset   _GroupByNum
               _FlattenPoint a           acdoc
               acspc         lst       obj
               tmp
              )

  (defun _GetBoundingBoxWithOffset (obj o / ll ur)
    (
     (lambda (a)
       (mapcar
     (function
       (lambda (b)
         (mapcar
           (function
         (lambda (c) ((eval c) a))
           )
           b
         )
       )
     )
     '(
       (
        (lambda (x) (- (caar x) o))
        (lambda (x) (- (cadar x) o))
       )
       (
        (lambda (x) (+ (caadr x) o))
        (lambda (x) (- (cadar x) o))
       )
       (
        (lambda (x) (+ (caadr x) o))
        (lambda (x) (+ (cadadr x) o))
       )
       (
        (lambda (x) (- (caar x) o))
        (lambda (x) (+ (cadadr x) o))
       )
      )
       )
     )
      (mapcar 'vlax-safearray->list
          (progn (vla-getboundingbox obj 'll 'ur) (list ll ur))
      )
    )
  )

  (defun _GroupByNum (l n / r)
    (if    l
      (cons
    (reverse (repeat n
           (setq r (cons (car l) r)
             l (cdr l)
           )
           r
         )
    )
    (_GroupByNum l n)
      )
    )
  )

  (defun _FlattenPoint (p)
    (list (car p) (cadr p) 0.0)
  )

  (setq    acdoc (vla-get-activedocument (vlax-get-acad-object))
    acspc (vlax-get-property
        acdoc
        (if (= 1 (getvar 'CVPORT))
          'Paperspace
          'Modelspace
        )
          )
  )
  (cond
    ((not (vlax-method-applicable-p obj 'GetBoundingBox))
    )
    (t
     (setq tmp
        (mapcar
          (function
        (lambda    (x)
          (apply 'vla-addline (cons acspc (mapcar 'vlax-3D-point x)))
        )
          )
          (_GroupByNum
        (mapcar    '_FlattenPoint
            (_GetBoundingBoxWithOffset obj (- fuzz))
        )
        2
          )
        )
     )
     (setq lst
        (mapcar
          (function
        (lambda    (x)
          (car
            (_GroupByNum
              (vlax-invoke obj 'Intersectwith x acExtendOtherEntity)
              3
            )
          )
        )
          )
          tmp
        )
     )
     (mapcar 'vla-delete tmp)
     lst
    )
  )
)

File bản vẽ test

http://www.cadviet.com/upfiles/3/86115_test.dwg

  • 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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

1). Trước hết, tôi vote cho bạn vì sự đam mê và tốn nhiều công sức cho lisp này.

2). Không biết vì lỗi gì mà tôi load thành công, dùng T1 thì cad báo không hiểu lệnh T1?

3). Tôi cũng đã viết xong lisp này, nhưng giờ chót quyết định không đưa lên vì sau khi test nhiều trường hợp thì phát hiện ra rằng: bài toán này không hội tụ (trong trường hợp tổng quát). Thật là công dã trà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

anhcos    196

anhcos
Đã đăng

 

11111.PNG

 

Lâu lắm mới thấy có đề bài hay, bạn vẽ thêm trường hợp tổng quát hơn ấy, như bạn nói có thể có 2*n vùng thì phải mà, lúc đó cách tính như thế nào?

 

 

  • 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

Skywings    49

Skywings
Đã đăng

1) Cảm ơn bác Hà vote :).

2) Cái này ko ý kiến, có thể CAD của bác bị lỗi gì đó.

3) Mình chưa test nhiều trường hợp, nhưng theo yêu cầu đầu bài thì Hội tụ thì ko phải là ko thể. Bác có thể up bản vẽ trường hợp Bác cho là ko hộ tụ để mình ngâm cứu.

  • 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

garupro    7

garupro
Đã đăng

 

 

Lâu lắm mới thấy có đề bài hay, bạn vẽ thêm trường hợp tổng quát hơn ấy, như bạn nói có thể có 2*n vùng thì phải mà, lúc đó cách tính như thế nào?

 

Untitled5555.png

Đây là một trường hợp phức tạp hơn. Đó là cùng 1 đường điều phối sẽ cắt đường tích lũy tại nhiều đoạn. Như hình trên là 3 đoạn, khi đó ta phải xá định để đảm bảo W1= W2 và Các đoạn Mi, Ni luôn < L cố định nào đó .

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

garupro    7

garupro
Đã đăng

Một bài toán hay, lâu rùi mới có hứng thú lại với Lisp ^^. Đây là giải pháp của mình dựa trên thuật toán của các bác đưa ra, nếu viết có luộm thuộm các bác thông cảm :D . Chưa có thời gian test kỹ, các bác dùng thử nhé ^_^ .

* Lưu ý kích thước MN quá nhỏ so với PQ có thể gây ra lỗi xác định diện tích, nếu PQ có nhiều điểm cực tiểu, chương trình chỉ tính toán cho điểm điểm cực tiểu thấp nhất.

(vl-load-com)
(defun c:t1 (/	       AREALST	 ENDPNT	   ENDPNTMN  FROMPNT
	     FUZZ      I0	 I1	   I2	     I3
	     INTPNTS   IX	 IY	   LWP0	     LWP1
	     LWPENT    LWPOBJ	 MN	   MNDIST    MSPACE
	     PNT0      PNT1	 PQ	   S0	     S1
	     S2	       S3	 STARTPNT  STARTPNTMN
	     STARTPNTPQ		 SUB01	   SUB01NEW  SUB32
	     SUB32NEW  THISDRAWING	   TMPLWP    TOPNTX
	     TOPNTY    MAXPOINT	 MINPOINT  ISFLIPED  TMPLWPOBJ
	     BOTPNT    MINMAXPNTS	   TOPPNT
	    )
  ;; Thiet lap
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace thisdrawing))
  (vla-startundomark thisdrawing)
  (setvar "CMDECHO" 0)
  (if (null MNdistSv)
    (setq MNdistSv 5)
  )
  ;; Du lieu dau vao
  (initget (+ 2 4))
  (setq	MNdist (getreal	(strcat	"\nXac dinh chieu dai MN: <"
				(rtos MNdistSv 2 2)
				">"
			)
	       )
  )
  (if (null MNdist)
    (setq MNdist MNdistSv)
    (setq MNdistSv MNdist)
  )
  (while (null
	   (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
	 )
    (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
  )
  (setq lwpObj (vlax-ename->vla-object lwpEnt))
  (setq	startPnt (vlax-curve-getStartPoint lwpObj)
	endPnt	 (vlax-curve-getEndPoint lwpObj)
  )
  ;; Kiem tra diem cuc tieu
  (setq MinMaxPnts (LM:CurveMinMax lwpObj 1e-8))
  (setq	TopPnt (cadr MinMaxPnts)
	BotPnt (car MinMaxPnts)
  )
  (if (or (equal (distance BotPnt startPnt) 0.0 1e-8)
	  (equal (distance BotPnt endPnt) 0.0 1e-8)
      )
    (progn
      (setq tmpLwpObj (vla-mirror
			lwpObj
			(vlax-3d-point startPnt)
			(vlax-3d-point (polar startPnt 0 0.1))
		      )
		      ;; lat bung
      )
      (vla-delete lwpObj)
      (setq lwpObj   tmpLwpObj
	    isFliped 1
      )
      (setq startPnt (vlax-curve-getStartPoint lwpObj)
	    endPnt   (vlax-curve-getEndPoint lwpObj)
      )
    )
  )
  (vla-GetBoundingBox lwpObj 'minpoint 'maxpoint)
  (vla-ZoomWindow (vlax-get-acad-object) minpoint maxpoint)
  ;; Xac dinh duong PQ
  (if (< (cadr startPnt) (cadr endPnt))
    (setq startPntPQ startPnt)
    (setq startPntPQ endPnt)
  )
  (setq	tmpLwp (AddLwpolyline
		 (list startPntPQ (polar startPntPQ 0 1))
		 0
		 mspace
	       )
  )
  (setq intPnts (LM:Intersections tmpLwp lwpObj acExtendThisEntity))
  (if (> (length intPnts) 1)
    (setq PQ (AddLwpolyline intPnts 0 mspace))
    (progn
      (vla-delete tmpLwp)
      (reset)
      (exit)
    )
  )
  (vla-delete tmpLwp)
  ;; Chieu dai doan MN
  (if (= isFliped 1)
    (setq BotPnt (car (LM:CurveMinMax lwpObj 1e-8)))
  )
  (setq	startPntMN (polar BotPnt pi (/ MNdist 2))
	endPntMN   (polar BotPnt 0 (/ MNdist 2))
  )
  (setq MN (AddLwpolyline (list startPntMN endPntMN) 0 mspace))
  ;; Xac dinh 2 duong giong tu MN den PQ
  (setq	pnt0 (vlax-curve-getClosestPointTo PQ startPntMN)
	pnt1 (vlax-curve-getClosestPointTo PQ endPntMN)
  )
  (setq	lwp0 (AddLwpolyline (list startPntMN pnt0) 0 mspace)
	lwp1 (AddLwpolyline (list endPntMN pnt1) 0 mspace)
  )
  ;; Kiem tra dien tich
  (setq AreaLst (CalArea pnt0 startPntMN endPntMN pnt1))
  (setq	s0 (nth 0 AreaLst)
	s1 (nth 1 AreaLst)
	s2 (nth 2 AreaLst)
	s3 (nth 3 AreaLst)
  )
  (if (and (< s0 s1)
	   (< s3 s2)
      )
    (progn
      (alert "Khong the dieu chinh!")
      (reset)
      (exit)
    )
  )
  ;; Can bang so bo 1 cap dien tich
  (textscr)
  (setq iY (- 0 (/ (distance startPntMN pnt0) 20)))
					; buoc nhay phuong doc
  (setq fuzz 0.01)			; do chinh xac dien tich
  (setq	FromPnt	(vlax-3d-point pnt0)
	ToPntY	(vlax-3d-point (polar pnt0 (/ pi 2) iY))
  )
  (while (and (>= (nth 0 AreaLst) (nth 1 AreaLst))
	      (>= (nth 3 AreaLst) (nth 2 AreaLst))
	 )
    (vla-move PQ FromPnt ToPntY)
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
	  pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
  )
  (if (> (- (nth 0 AreaLst) (nth 1 AreaLst))
	 (- (nth 3 AreaLst) (nth 2 AreaLst))
      )
    (setq i0 3
	  i1 2
	  i2 1
	  i3 0
    )
    (setq i0 0
	  i1 1
	  i2 2
	  i3 3
    )
  )
  (setq sub32 (- (nth i3 AreaLst) (nth i2 AreaLst)))
  ;; Can bang dien tich dua tren dich chuyen PQ
  (while (not (equal (- (nth i3 AreaLst) (nth i2 AreaLst)) 0.0 fuzz))
    (vla-move PQ
	      (vlax-3d-point pnt0)
	      (vlax-3d-point (polar pnt0 (/ pi 2) iY))
    )
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
	  pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq iX 0.1)			; buoc nhay phuong ngang
    (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
    (setq sub01 (- (nth i0 AreaLst) (nth i1 AreaLst)))
    (setq FromPnt (vlax-3d-point pnt0)
	  ToPntX  (vlax-3d-point (polar pnt0 0 iX))
    )
    ;; Can bang dien tich dua tren dich chuyen MN
    (while (not (equal (- (nth i0 AreaLst) (nth i1 AreaLst)) 0.0 fuzz))
      (vla-move MN FromPnt ToPntX)
      (vla-move lwp0 FromPnt ToPntX)
      (vla-move lwp1 FromPnt ToPntX)
      (setq pnt0       (polar pnt0 0 iX)
	    pnt1       (polar pnt1 0 iX)
	    startPntMN (polar startPntMN 0 iX)
	    endPntMN   (polar endPntMN 0 iX)
      )
      (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
      (setq sub01new (- (nth i0 AreaLst) (nth i1 AreaLst)))
      (if (> (abs sub01new) (abs sub01))
	(setq iX (/ (- 0 iX) 2))
      )
      (setq sub01 sub01new)
      (setq FromPnt (vlax-3d-point pnt0)
	    ToPntX  (vlax-3d-point (polar pnt0 0 iX))
      )
    )
    (setq sub32new (- (nth i3 AreaLst) (nth i2 AreaLst)))
    (if	(> (abs sub32new) (abs sub32))
      (setq iY (/ (- 0 iY) 2))
    )
    (setq sub32 sub32new)
    (print AreaLst)
  )
  (vla-zoomprevious (vlax-get-acad-object))
  (reset)
  (princ)
)
(defun reset ()
  (if (= isFliped 1)
    (progn
      (foreach obj (list lwpObj MN PQ lwp0 lwp1)
	(vla-mirror
	  obj
	  (vlax-3d-point startPnt)
	  (vlax-3d-point (polar startPnt 0 0.1))
	)
	(vla-delete obj)
      )
    )
  )
  (vla-endundomark thisdrawing)
  (graphscr)
)
(defun CalArea (p0 p1 p2 p3 / AreaLst tmpLwp)
  (setq	p0 (polar p0 (* pi 1.25) 0.1)
	p1 (polar p1 (* pi 0.25) 0.1)
	p2 (polar p2 (* pi 0.75) 0.1)
	p3 (polar p3 (* pi 1.75) 0.1)
  )
  (foreach pt (list p0 p1 p2 p3)
    (command ".boundary" pt "")
    (setq tmpLwp (vlax-ename->vla-object (entlast)))
    (setq AreaLst (cons (vlax-get-property tmpLwp 'AREA) AreaLst))
    (vla-delete tmpLwp)
  )
  AreaLst
)
(defun LM:Intersections	(obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
	  l (cdddr l)
    )
  )
  (reverse r)
)

(defun AddLwpolyline (lst-pnt layer *model-space* / array-pt myPline)
  (setq	array-pt (list->variantArray
		   (apply 'append (mapcar '3dPnt->2dPnt lst-pnt))
		 )
	myPline	 (vla-AddLightWeightPolyline *model-space* array-pt)
  )
  (vla-put-layer myPline layer)
  myPline
)

(defun list->variantArray (ptsList / arraySpace sArray)
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble
	   (cons 0
		 (- (length ptsList) 1)
	   )
	 )
  )
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
  (vlax-make-variant sArray)
)

(defun 3dPnt->2dPnt (3dpt)
  (list (float (car 3dpt)) (float (cadr 3dpt)))
)

(defun LM:CurveMinMax
		      (obj	     fuzz	   /
		       _GetBoundingBoxWithOffset   _GroupByNum
		       _FlattenPoint a		   acdoc
		       acspc	     lst	   obj
		       tmp
		      )

  (defun _GetBoundingBoxWithOffset (obj o / ll ur)
    (
     (lambda (a)
       (mapcar
	 (function
	   (lambda (b)
	     (mapcar
	       (function
		 (lambda (c) ((eval c) a))
	       )
	       b
	     )
	   )
	 )
	 '(
	   (
	    (lambda (x) (- (caar x) o))
	    (lambda (x) (- (cadar x) o))
	   )
	   (
	    (lambda (x) (+ (caadr x) o))
	    (lambda (x) (- (cadar x) o))
	   )
	   (
	    (lambda (x) (+ (caadr x) o))
	    (lambda (x) (+ (cadadr x) o))
	   )
	   (
	    (lambda (x) (- (caar x) o))
	    (lambda (x) (+ (cadadr x) o))
	   )
	  )
       )
     )
      (mapcar 'vlax-safearray->list
	      (progn (vla-getboundingbox obj 'll 'ur) (list ll ur))
      )
    )
  )

  (defun _GroupByNum (l n / r)
    (if	l
      (cons
	(reverse (repeat n
		   (setq r (cons (car l) r)
			 l (cdr l)
		   )
		   r
		 )
	)
	(_GroupByNum l n)
      )
    )
  )

  (defun _FlattenPoint (p)
    (list (car p) (cadr p) 0.0)
  )

  (setq	acdoc (vla-get-activedocument (vlax-get-acad-object))
	acspc (vlax-get-property
		acdoc
		(if (= 1 (getvar 'CVPORT))
		  'Paperspace
		  'Modelspace
		)
	      )
  )
  (cond
    ((not (vlax-method-applicable-p obj 'GetBoundingBox))
    )
    (t
     (setq tmp
	    (mapcar
	      (function
		(lambda	(x)
		  (apply 'vla-addline (cons acspc (mapcar 'vlax-3D-point x)))
		)
	      )
	      (_GroupByNum
		(mapcar	'_FlattenPoint
			(_GetBoundingBoxWithOffset obj (- fuzz))
		)
		2
	      )
	    )
     )
     (setq lst
	    (mapcar
	      (function
		(lambda	(x)
		  (car
		    (_GroupByNum
		      (vlax-invoke obj 'Intersectwith x acExtendOtherEntity)
		      3
		    )
		  )
		)
	      )
	      tmp
	    )
     )
     (mapcar 'vla-delete tmp)
     lst
    )
  )
)

File bản vẽ test

http://www.cadviet.com/upfiles/3/86115_test.dwg

 

Cảm ơn bạn. Chạy được rùi. Nhưng bạn có thể giúp mình sửa nó để có thể áp dụng vào bài sau được không .

123.png

Yêu cầu: Đó là, cái đường điều phối ta vẽ trước đó, từ đó ta xác định nó cắt tại bao nhiêu điểm, như hình trên thì ta có 5 khối .Sau đó vẫn như yêu cầu trên là tìm vị trí đường điều phối mà cả 5 khối đó đều thỏa mãn các điều kiện như trước (đoạn MN của các khối không bằng nhau nhưng phải <= L cố định ). Sau khi tính xong thì ta phải được một hình hoàn chỉnh như khối 1 ( Có hatch, ghi kích thước ) .

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

Doan Van Ha
Đã đăng

1) Cảm ơn bác Hà vote :).

2) Cái này ko ý kiến, có thể CAD của bác bị lỗi gì đó.

3) Mình chưa test nhiều trường hợp, nhưng theo yêu cầu đầu bài thì Hội tụ thì ko phải là ko thể. Bác có thể up bản vẽ trường hợp Bác cho là ko hộ tụ để mình ngâm cứu.

Bạn thử test bản vẽ này xem.

http://www.cadviet.com/upfiles/3/67029_chia_dien_tich_1.dwg

Tôi test nó toàn báo lỗi thế này:

Command: T1

Xac dinh chieu dai MN: <900>300

Chon duong cong tich luy:

Command:

Point is directly on an object.

Point is directly on an object.

Point is directly on an object.

Point is directly on an object.; error: Automation Error. Object was erased

 

Còn đây là lisp tôi đã viết: lisp cân bằng diện tích của đường cong tích lũy.

Tuy nhiên cần khẳng định rằng: tùy thuộc dữ liệu đầu vào mà bài toán này có thể hội tụ hoặc không.



 


; Doan Van Ha - CADViet.com - Ngay 22/4/2013


; Chuc nang: C©n b»ng diÖn tich cña ®­êng cong tich luy.


(defun C:HA( / dung len giaso sscp CU lst G P Q M M1 N N1 MP Px GM GN S1 S2 S3 S4 ss12 ss34)


 (setq len (getdist "\nNhap khoang cach MN: "))


 (setq sscp (getreal "\nSai so toi da <0.05>: "))


 (if (not sscp) (setq sscp 0.05)) ;MÆc ®inh 0.05 (tøc 5%). Sai sè cµng nhá th× ch¹y cµng chËm, vµ nhieu khi kh«ng tinh to¸n ®­îc.


 (setq giaso (* len sscp 0.2))


 (setq CU (car (entsel "\nChon duong cong tich luy dang Pline: ")))


 (setq lstCU (vl-sort (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget CU))) '(lambda (e1 e2) (< (car e1) (car e2)))))


 (setq MP (polar (setq G (Pymin lstCU)) pi len)) ; lÊy MP & G


 (setq P (vlax-curve-getStartpoint CU) Q (vlax-curve-getEndpoint CU)) (if (< (cadr Q) (cadr P)) (setq P Q)) ; lÊy ®iÓm thÊp nhÊt


 (if (< (car P) (car Q)) (setq lst (Giao lstCU P (polar P 0 1E8))) (setq lst (Giao lstCU Q (polar Q 0 1E8)))) ; lÊy list point giao víi Curve


 (setq P (car lst) Q (last lst)) (if (< (car Q) (car P)) (setq Px P P Q Q Px)) ; lÊy ®iÓm bªn tr¸i


 (if (> (car MP) (car P)) (setq P (car (Giao lstCU MP (polar MP (/ pi 2) 1E8)))))


 (while (and (not dung) (> (cadr P) (+ giaso (cadr G))))


  (setq lst (Giao lstCU (setq P (polar P (/ pi -2) giaso)) (polar P 0 1E8)))


  (setq P (car lst) Q (last lst)) (if (< (car Q) (car P)) (setq Px P P Q Q Px)) ; lÊy P vµ Q


  (setq M (list (+ giaso (car P)) (cadr G)) N (polar M 0 len))


  (while (and (not dung) (< (+ giaso (car M)) (car G)) (< (+ giaso (car N)) (car Q)))


   (setq M (polar M 0 giaso) M1 (list (car M) (cadr P)) N (polar M 0 len) N1 (list (car N) (cadr M1))) ; lÊy M, M1, N, N1


   (setq GM (car (Giao lstCU M M1)) GN (car (Giao lstCU N N1))) ; lÊy GM, GN


   (setq S1 (PointArea (cons M1 (LST_P lstCU P GM))))


   (setq S2 (PointArea (cons M (LST_P lstCU GM G))))


   (setq S3 (PointArea (cons N (LST_P lstCU G GN))))


   (setq S4 (PointArea (cons N1 (LST_P lstCU GN Q))))


   (setq ss12 (abs (/ (- S1 S2) (* 0.5 (+ S1 S2)))))


   (setq ss34 (abs (/ (- S3 S4) (* 0.5 (+ S3 S4)))))


   (if (<= (max ss12 ss34) sscp) (progn (LWPoly (list P M1 M N N1 Q)) (setq dung T)))))


 (if (not dung) (alert "Hoac sai so qua nho; \nHoac khoang cach MN qua lon, khong hoi tu nen khong giai duoc.")))


(defun Giao(lst p1 p2 / z pg lst1)


 (setq z -1)


 (repeat (1- (length lst))


  (if (setq pg (inters p1 p2 (nth (setq z (1+ z)) lst) (nth (1+ z) lst))) (setq lst1 (cons pg lst1))))


 lst1)


(defun PointArea (lst)


 (/ (abs (apply '+ (mapcar (function (lambda (a B) (- (* (car a) (cadr B)) (* (car B) (cadr a))))) lst (append (cdr lst) (list (car lst)))))) 2.0))


(defun LST_P(lst p1 p2 / pt lst lst1)


 (setq lst1 (vl-remove-if '(lambda (pt) (or (< (car pt) (car p1)) (> (car pt) (car p2)))) (cons p1 (reverse (cons p2 (reverse lst)))))))


(defun Pymin(lst)


 (setq pt (car lst)) (foreach px (cdr lst) (if (< (cadr px) (cadr pt)) (setq pt px))) pt)


(defun LWPoly(lst)


 (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst))) 


   (mapcar (function (lambda (p) (cons 10 p))) lst))))







			
		


		

			
				
					

	
	
		

			
				
				

					
						

	
	
    
	
		
			
			
  • 
				
					
				
						
							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

				

	

			
		

	



	



					
				
					
					
					







	

	

		

			
Skywings
			  

	
		
	
			 49
	
		
	

		

		

			


	
		Skywings
	

		

	

	
	

		



	

	

		

			
		


		

			Đã đăng  
			
				
				
			
		

	


	


	

		
		

			

Cập nhật bản sửa lỗi ở bài viết #18


- Cho phép xác định độ chính xác diện tích.


- Giới hạn 100 lần thử để bảo vệ con CPU ko bị bốc khói ^^! Trường hợp này xảy ra khi diện tích tính toán quá lớn trong khi sai số cho phép quá nhỏ!!!


- Sửa lỗi khi tính toán diện tích, hạn chế và bẫy lỗi do lệnh "-boundary" gây ra. Thg này tính khí cũng hơi thất thường, có lúc cái miền to đùng mà ko lấy boundary được >.<!!


- Cải thiện tốc độ x2 ^^.


 


@ bác Hà: đã test bản sửa lỗi trên bản vẽ của bác, chạy hơi lâu một chút do kích thước pline của bác hơi bị bự ^^. Mình đã dùng thử file lisp của bác trên bản vẽ bác cung cấp, nhưng lúc được lúc không. Hay báo lỗi "Hoac sai so qua nho; \nHoac khoang cach MN qua lon, khong hoi tu nen khong giai duoc." mặc dù mình chọn kích thước khá lớn là 300, sai số mặc định. Khi chạy được sai số diện tích cũng khá lớn.


 


@ garupro: trường hợp "phức tạp" bác đưa ra dường như là một bài toán hoàn toàn khác so với trg hợp "đơn giản" ban đầu. Mình có chút thắc mắc:


- Đường tích luỹ là pline "gãy" hay "trơn" (có đoạn cong). Nếu là "gãy" thì có thể bàn tiếp, nếu lỡ "trơn" mà các điểm cực trị lọt vào bụng tròn tròn của nó thì pó tay, ko biết sao xác định tất cả các điểm đó. Bác cao thủ nào có ý tưởng về vấn đề này xin góp ý ^^.


- Theo hình bài số 22, nếu W1 và W2 là từng cặp cân bằng riêng biệt, bài toán le lói hy vọng; còn nếu W1 và W2 là 2 con số cố định cho tất cả các cặp MN thì thiệt tình mình cho là không khả thi với đường PQ cố định, PQ mà di động thì cũng thua vì quá phức tạp. Với trường hợp tổng quát 2*n vùng thì không máy nào chịu nổi, nên có giới hạn số vùng tính toán.


- Với L và đường PQ cố định, chấp nhận một đoạn MN ko thể cân bằng diện tích vì MN có thể lớn L.



			
		


		

			
				
					

	
	
		

			
				
				

					
						

	
	
    
	
		
			
			
  • 
				
					
				
						
							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

				

	

			
		

	



	



					
				
			
			



		

	


	
		

			

	
	

		

	

	
		
		

			
				
				





	
	
		

			
				
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
				Lập trình khác
			
		
	

	




	

	

	




						


					

					


					

				

			

			
		

		
		


	×