Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
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 ?

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

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

1). Sai số cần hiểu là sai số tương đối (ví dụ 0.05 là 5%), chứ ai lại lấy sai số tuyệt đối?

2). Tôi test với MN=300 và sai số 0.05 thì nó chạy vô tư.

3). Khi có dòng thông báo ấy không có nghĩa là lỗi => thay sai số hoặc/và kích thước MN để chạy lại.

4). Tôi test lisp của bạn trên bản vẽ tôi gởi với MN=500 => lỗi.

Nói chung, gia số tăng giảm mỗi lần và sai số cho phép bạn nên lấy theo con số tương đối chứ đừng lấy tuyệt đối, bởi kích thước MN có thể là 5 mà cũng có thể là 50000000 (tùy theo tỉ lệ khi vẽ).

  • 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

Cám ơn bác Hà, mình đã hiểu ý bác. Khởi động lại AutoCAD thì dùng đc lisp của bác, hay là bị đụng j đó :wacko: ! Mình đã test lại lisp mình với MN=500, thì vẫn ok, có thể lỗi do sự thất thường của lệnh -boundary chăng :mellow: ?

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

Cám ơn bác Hà, mình đã hiểu ý bác. Khởi động lại AutoCAD thì dùng đc lisp của bác, hay là bị đụng j đó :wacko: ! Mình đã test lại lisp mình với MN=500, thì vẫn ok, có thể lỗi do sự thất thường của lệnh -boundary chăng :mellow: ?

Rất có thể là do lệnh Boundary. Khi mà diện tích này quá nhỏ so với màn hình (do bước nhảy) thì lệnh B này có thể gây lỗi. Một số lệnh khác như Hatch cũng vậy.

Có 1 nguyên tắc mà tất cả người lập trình đều phải chấp nhận, là biết chấp nhận mọi tùy thích của người dùng, kể cả khi họ ngớ ngẩn. Nhưng làm được điều này là cực khó, không cứ là bạn hay tôi mà các lập trình viên chuyên nghiệp cũng vậy

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

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.

-Đường tích  lũy là gãy bạn ah, không có đoạn cong , W1,W2 là các cặp khác nhau riêng biệt đối với từng cặp MN, Đường PQ không cố định bạn ah, vẫn có thể di chuyển lên xuống nhưng vẫn đảm bảo số điểm giao với đường tích lũy

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

Nhiều yếu tố động quá -> độ khó tăng theo cấp số nhân so với bài toán ban đầu :wacko: . Hiện tại mình ko có thời gian nghiên cứu tiếp và cũng cảm thấy ko có năng lực đó :mellow: , đành thấy khó mà rút lui, sr bác chủ thớt :) . Hy vọng bác Hà có giải pháp cho bạn hoặc là có bác cao thủ nào đó bỏ ít thời gian dòm ngó bài toán của bạn ^_^ . Good luck ;) !

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

Nhiều yếu tố động quá -> độ khó tăng theo cấp số nhân so với bài toán ban đầu :wacko: . Hiện tại mình ko có thời gian nghiên cứu tiếp và cũng cảm thấy ko có năng lực đó :mellow: , đành thấy khó mà rút lui, sr bác chủ thớt :) . Hy vọng bác Hà có giải pháp cho bạn hoặc là có bác cao thủ nào đó bỏ ít thời gian dòm ngó bài toán của bạn ^_^ . Good luck ;) !

1). Bài toán đầu tiên: có trường hợp vô nghiệm (dù đã có 2 lisp).

2). Bài toán này: có trường hợp vô nghiệm + có cả trường hợp vô số nghiệm (do điều kiện Li <= L cố định) => không thể giả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

Nếu vô nghiệm thì phải thay đổi L, lúc đó sẽ có khả năng tìm ra.

Với lại nếu có nghiệm thì cũng giải gần đúng theo một độ chính xác 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

Nếu vô nghiệm thì phải thay đổi L, lúc đó sẽ có khả năng tìm ra.

Với lại nếu có nghiệm thì cũng giải gần đúng theo một độ chính xác nào đó.

1). Thay L thì có khả năng tìm ra: OK. Thường là cho nó nhỏ dần đi.

2). Giải gần đúng: OK. Bài toán này nếu biết phương trình đường cong, giải bằng tích phân thì may ra mới có nghiệm chính xác, chứ cad thì thế thôi.

3). Còn vô số nghiệm thì phải xử thế nào? Thật ra là do điều kiện các Li <= L là quá rộng nên mới sinh ra chuyện này!

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

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

 

Đối với một khối đã khó (vì bài toán chưa lấy gì chắc chắc đã hội tụ với một giá trị sai số tương đối chấp nhận được 0.5%?!!). Bạn yêu cầu đồng thời năm khối (hoặc sau đó có lẽ nhiều hơn!) + MN <= Const --> khả năng không hội tụ của bài toán được tăng lên theo cấp luỹ thừa (theo quy tắc nhân thì có lẽ như vậy?!!). Trong trường hợp này sao bạn không giới hạn cận dưới cho đoạn MN? Nếu MN dần về 0 thì bài toán xem như có cơ hội hội tụ được nhiều hơn. Tuy nhiên, về mặt lập trình thì lại vất vả hơn, vì số trường hợp thử tăng lên quá nhiều, có vẻ như không tưởng?

 

Tôi mạo muội đề nghị bạn như thế này không biết có hồ đồ quá không nhé:

Trước hết, bạn dùng LISP (của bác Skywings hoặc bác Doan Van Ha) chạy cho từng khối, với độ chính xác MỊN hơn độ chính xác bạn kì vọng --> đường điều phối cho từng tường hợp. Nhưng vì bài toán của bạn tuỳ vào sai số, có thể vô nghiệm hoặc vô số nghiệm --> Bạn nên chọn đường điều phối nào mà MN nằm tương đối cân bằng với đường cong tích luỹ.

 

Sau đó, Từ nhóm đường điều phối thu được, bạn cân bằng theo nguyên tắc cân bằng Moment (tôi nói như vậy cho dễ hình dung) với "giá trị lực" là các giá trị diện tích thành phần tương ứng (hoặc chọn tất cả lớn hơn, hoặc chọn tất cả nhỏ hơn tại mỗi khối?!!!)

Hình vẽ minh hoạ như sau:

 

118347_12345.jpg

 

Nói vòng vòng vậy thôi, mong các bác thư giản và chém nhẹ tay, thật ra trong cách làm trên không có một "đạo lý" nào hết, tự mình "cảm thấy" làm vậy có vẻ được được! Hì hì hì.

 

P/S: Vote 2 bác: Skywings Doan Van Ha vì kiến thức và sự nhiệt tình của các bác!

 

(*) Thật ra là có một "đạo lý" nho nhỏ, nếu thay S1; S2; ... ; Sn bằng các vecto số gia sai số diện tích thành phần tương ứng, đối với mỗi vị trí của MN xác định, nếu đường điều phối (DDP) di chuyển lên trên thì sẽ ứng với một "số gia sai số diện tích", nếu DDP di chuyển xuống dưới sẽ ứng với một "số gia sai số diện tích" khác nữa...

Tuy nhiên, ở đây có 2 điều không hợp lý:

1. Đường PL không có quy luật (hàm số) rõ ràng.

2. "Số gia" (ví dụ: gia tốc...) là "dự đoán" cho cho bước tiếp theo, còn trong trường hợp chúng ta thì giá trị này là do các giá trị cũ mà suy ra (khác nhau về mặt bản chất, một bên là quy luật, một bên là mò mẫm dự đoán?!!!)

  • 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

Tôi cũng vote cho bạn vì đã bỏ công sức ra để đầu tư một comment có khoa học.

Tôi nghĩ, do chủ topic không nói rõ bản chất của y/c này khiến bài toán mông lung, chứ nếu y/c rõ ràng hơn từ vấn đề thực tế thì còn le lói hy vọng.

Có một điều rất mệt: đó là chủ topic lúc đầu chỉ y/c đưa ra giải thuật (chứ không phải lisp), bây giờ nãy sinh những lisp khác, với y/c khó hơn nhưng đầu bài khá mơ hồ.

Tôi vẫn còn ham muốn bài toán này, nhưng chừng nào chủ topic đưa y/c thực tế hơn và rõ ràng hơn thì sẽ quay lại để... khổ với nó.

  • 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

Cảm ơn các bạn đã quan tâm và giúp đỡ, nhưng xem chừng yêu cầu của mình hơi cao. Vì vậy mình xin đưa bài toán của mình về đơn giản nhất mong các bạn viết giúp mình để giải quyết nó với (thực ra mình đã làm được với Net nhưng tốc độ chậm quá) nên nhờ các bạn viết dùm mình cái lisp vậy

3566.png

 

Lisp này mình sử dụng kết hợp với Net  nền việc chọn đối tượng nếu có thể thì chọn theo cách nhập Handle của đối tượng đó

Yêu cầu như sau :

Nhập Handle của đường cong tích luỹ

Nhập Handle của đường điều phối (ĐƯờng này mình tự vạch đấy)

Nhập Sai số cho phép

 

Sau đó Lisp sẽ tự làm như sau :Xác định giao điểm của đường điều phối với đường cong tích luỹ phân thành các khối ( ví dụ trong hình là 3 khối)

Xét từng khối 1, ví dụ với khối 1 ta chia ra làm 2. 1 từ điểm A đến cực trị của đường cong ta vẽ đường Line 1 và dịch sang trái hợc phải khi nào W1 = W2 thì dùng lại, tương tự nửa còn lại ta vẽ Line 2 và dịch nó khi W1 = W2 thì dừng sau khi hết 1 khối thì ghi kích thước và hatch như trong hình sau đó chuyển sang khối khác cho đến hết ( Khi dịch chuyển Line sang trái phải hiện luôn cái W1, W2 trên màn hình sau khi chia xong thì xoá)

Trên  diễn đàn mình cũng có 1 lisp chia đa giác thành 2 phần bằng nhau rồi, nhưng không ứng dụng vào bài của mình được. Các bạn giúp mình nha. Không biết tý gì về lisp nên đành làm phiền các bạn vậy .

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

Cảm ơn các bạn đã quan tâm và giúp đỡ, nhưng xem chừng yêu cầu của mình hơi cao. Vì vậy mình xin đưa bài toán của mình về đơn giản nhất mong các bạn viết giúp mình để giải quyết nó với (thực ra mình đã làm được với Net nhưng tốc độ chậm quá) nên nhờ các bạn viết dùm mình cái lisp vậy

 

...................

Ô hay! đi trên đường cao tốc (Net) mà tốc độ lại chậm ???

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Ô hay! đi trên đường cao tốc (Net) mà tốc độ lại chậm ???

Đường tốt mà xe cà rịch cà tang thì cũng lê từng bước thôi.  :lol:

Với bài toán này thì tính chính xác luôn, tốc độ sẽ nhanh cực, vì nó... dễ :lol:

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

Cảm ơn các bạn đã quan tâm và giúp đỡ, nhưng xem chừng yêu cầu của mình hơi cao. Vì vậy mình xin đưa bài toán của mình về đơn giản nhất mong các bạn viết giúp mình để giải quyết nó với (thực ra mình đã làm được với Net nhưng tốc độ chậm quá) nên nhờ các bạn viết dùm mình cái lisp vậy

 

 

Lisp này mình sử dụng kết hợp với Net  nền việc chọn đối tượng nếu có thể thì chọn theo cách nhập Handle của đối tượng đó

Yêu cầu như sau :

Nhập Handle của đường cong tích luỹ

Nhập Handle của đường điều phối (ĐƯờng này mình tự vạch đấy)

Nhập Sai số cho phép

 

Sau đó Lisp sẽ tự làm như sau :Xác định giao điểm của đường điều phối với đường cong tích luỹ phân thành các khối ( ví dụ trong hình là 3 khối)

Xét từng khối 1, ví dụ với khối 1 ta chia ra làm 2. 1 từ điểm A đến cực trị của đường cong ta vẽ đường Line 1 và dịch sang trái hợc phải khi nào W1 = W2 thì dùng lại, tương tự nửa còn lại ta vẽ Line 2 và dịch nó khi W1 = W2 thì dừng sau khi hết 1 khối thì ghi kích thước và hatch như trong hình sau đó chuyển sang khối khác cho đến hết ( Khi dịch chuyển Line sang trái phải hiện luôn cái W1, W2 trên màn hình sau khi chia xong thì xoá)

Trên  diễn đàn mình cũng có 1 lisp chia đa giác thành 2 phần bằng nhau rồi, nhưng không ứng dụng vào bài của mình được. Các bạn giúp mình nha. Không biết tý gì về lisp nên đành làm phiền các bạn vậy .

xưa giờ mới thấy 1 lisp hay Addin .NET yêu cầu người dùng nhập Handle  :blink:

move line 1 rồi line 2 làm sao? giữ nguyên? hay move? step là bao nhiêu, làm sao tính được area của hình bất kỳ kia (dùng boundary của CAD?)  cách suy nghĩ theo "auto tay" thì có viết bằng ARX nó vẫn chạy mút mùa :D

Have fun!

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ôi chỉ code cho bạn cách chia S thôi, còn ba thứ lăng nhăng như hatch và dimension thì không hứng lắm, với nó còn phụ thuộc sở thích của người dùng.

Cái này chạy tức thì, không cần mò dần, kết quả đúng tuyệt đối.


 

(defun C:HA( / obj1 obj2 ent1 lstg lst1 lst z p1 p2 lstx lstt lstp St Stt pt Sp Spp pp)
 (vl-load-com)
 (setq obj1 (vlax-ename->vla-object (setq ent1 (car (entsel "\nChon duong cong tich luy Pline: ")))))
 (setq obj2 (vlax-ename->vla-object (car (entsel "\nChon duong dieu phoi: "))))
 (setq lstg (vl-sort (LM:Intersections obj1 obj2 acExtendNone) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent1))))
 (setq lst (vl-sort (append lstg lst1) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst (vl-remove-if '(lambda(pt) (or (< (car pt) (caar lstg)) (> (car pt) (car (last lstg))))) lst))
 (setq z -1)
 (repeat (1- (length lstg))
  (setq p1 (nth (setq z (1+ z)) lstg) p2 (nth (1+ z) lstg))
  (setq lstx (vl-remove-if '(lambda(pt) (or (< (car pt) (car p1)) (> (car pt) (car p2)))) lst))
  (setq lstt (vl-remove-if '(lambda(pt) (> (car pt) (car (Cuctri lstx)))) lstx))
  (setq lstp (vl-remove-if '(lambda(pt) (< (car pt) (car (Cuctri lstx)))) lstx))
  (setq St (PointArea (cons (list (car (last lstt)) (cadr (car lstt))) lstt)))
  (setq Stt (PointArea (cons (list (car (car lstt)) (cadr (last lstt))) lstt)))
  (setq pt (polar p1 0 (* (/ Stt (+ Stt St)) (- (car (Cuctri lstx)) (car p1)))))
  (setq Sp (PointArea (cons (list (car (car lstp)) (cadr (last lstp))) lstp)))
  (setq Spp (PointArea (cons (list (car (last lstp)) (cadr (car lstp))) lstp)))
  (setq pp (polar p2 pi (* (/ Spp (+ Sp Spp)) (- (car p2) (car (Cuctri lstx))))))
  (LWPoly (list pt (list (car pt) (cadr (Cuctri lstx))) (list (car pp) (cadr (Cuctri lstx))) pp))))
;-----
(defun LM:Intersections(obj1 obj2 mode / lst r)
 (setq lst (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length lst) 3)
  (setq r (cons (list (car lst) (cadr lst) (caddr lst)) r) lst (cdddr lst)))
 r)
(defun Cuctri(lst / p1)
 (if (vl-remove-if '(lambda(pt) (>= (cadr pt) (cadar lst))) lst)
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (< (cadr pt) (cadr p1)) (setq p1 pt))))
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (> (cadr pt) (cadr p1)) (setq p1 pt)))))
 p1)
(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))))
(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 C:HA( / obj1 obj2 ent1 lstg lst1 lst z p1 p2 lstx lstt lstp St Stt pt Sp Spp pp)
 (vl-load-com)
 (setq obj1 (vlax-ename->vla-object (setq ent1 (car (entsel "\nChon duong cong tich luy Pline: ")))))
 (setq obj2 (vlax-ename->vla-object (car (entsel "\nChon duong dieu phoi: "))))
 (setq lstg (vl-sort (LM:Intersections obj1 obj2 acExtendNone) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent1))))
 (setq lst (vl-sort (append lstg lst1) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst (vl-remove-if '(lambda(pt) (or (< (car pt) (caar lstg)) (> (car pt) (car (last lstg))))) lst))
 (setq z -1)
 (repeat (1- (length lstg))
  (setq p1 (nth (setq z (1+ z)) lstg) p2 (nth (1+ z) lstg))
  (setq lstx (vl-remove-if '(lambda(pt) (or (< (car pt) (car p1)) (> (car pt) (car p2)))) lst))
  (setq lstt (vl-remove-if '(lambda(pt) (> (car pt) (car (Cuctri lstx)))) lstx))
  (setq lstp (vl-remove-if '(lambda(pt) (< (car pt) (car (Cuctri lstx)))) lstx))
  (setq St (PointArea (cons (list (car (last lstt)) (cadr (car lstt))) lstt)))
  (setq Stt (PointArea (cons (list (car (car lstt)) (cadr (last lstt))) lstt)))
  (setq pt (polar p1 0 (* (/ Stt (+ Stt St)) (- (car (Cuctri lstx)) (car p1)))))
  (setq Sp (PointArea (cons (list (car (car lstp)) (cadr (last lstp))) lstp)))
  (setq Spp (PointArea (cons (list (car (last lstp)) (cadr (car lstp))) lstp)))
  (setq pp (polar p2 pi (* (/ Spp (+ Sp Spp)) (- (car p2) (car (Cuctri lstx))))))
  (LWPoly (list pt (list (car pt) (cadr (Cuctri lstx))) (list (car pp) (cadr (Cuctri lstx))) pp))))
;-----
(defun LM:Intersections(obj1 obj2 mode / lst r)
 (setq lst (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length lst) 3)
  (setq r (cons (list (car lst) (cadr lst) (caddr lst)) r) lst (cdddr lst)))
 r)
(defun Cuctri(lst / p1)
 (if (vl-remove-if '(lambda(pt) (>= (cadr pt) (cadar lst))) lst) ;co cuc tieu
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (< (cadr pt) (cadr p1)) (setq p1 pt))))
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (> (cadr pt) (cadr p1)) (setq p1 pt)))))
 p1)
(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))))
(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))
[/lisp]
(defun C:HA( / obj1 obj2 ent1 lstg lst1 lst z p1 p2 lstx lstt lstp St Stt pt Sp Spp pp)
 (setq obj1 (vlax-ename->vla-object (setq ent1 (car (entsel "\nChon duong cong tich luy Pline: ")))))
 (setq obj2 (vlax-ename->vla-object (car (entsel "\nChon duong dieu phoi: "))))
 (setq lstg (vl-sort (LM:Intersections obj1 obj2 acExtendNone) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst1 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent1))))
 (setq lst (vl-sort (append lstg lst1) '(lambda (e1 e2) (< (car e1) (car e2)))))
 (setq lst (vl-remove-if '(lambda(pt) (or (< (car pt) (caar lstg)) (> (car pt) (car (last lstg))))) lst))
 (setq z -1)
 (repeat (1- (length lstg))
  (setq p1 (nth (setq z (1+ z)) lstg) p2 (nth (1+ z) lstg))
  (setq lstx (vl-remove-if '(lambda(pt) (or (< (car pt) (car p1)) (> (car pt) (car p2)))) lst))
  (setq lstt (vl-remove-if '(lambda(pt) (> (car pt) (car (Cuctri lstx)))) lstx))
  (setq lstp (vl-remove-if '(lambda(pt) (< (car pt) (car (Cuctri lstx)))) lstx))
  (setq St (PointArea (cons (list (car (last lstt)) (cadr (car lstt))) lstt)))
  (setq Stt (PointArea (cons (list (car (car lstt)) (cadr (last lstt))) lstt)))
  (setq pt (polar p1 0 (* (/ Stt (+ Stt St)) (- (car (Cuctri lstx)) (car p1)))))
  (setq Sp (PointArea (cons (list (car (car lstp)) (cadr (last lstp))) lstp)))
  (setq Spp (PointArea (cons (list (car (last lstp)) (cadr (car lstp))) lstp)))
  (setq pp (polar p2 pi (* (/ Spp (+ Sp Spp)) (- (car p2) (car (Cuctri lstx))))))
  (LWPoly (list pt (list (car pt) (cadr (Cuctri lstx))) (list (car pp) (cadr (Cuctri lstx))) pp))))
;-----
(defun LM:Intersections(obj1 obj2 mode / lst r)
 (setq lst (vlax-invoke obj1 'intersectwith obj2 mode))
 (repeat (/ (length lst) 3)
  (setq r (cons (list (car lst) (cadr lst) (caddr lst)) r) lst (cdddr lst)))
 r)
(defun Cuctri(lst / p1)
 (if (vl-remove-if '(lambda(pt) (>= (cadr pt) (cadar lst))) lst) ;co cuc tieu
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (< (cadr pt) (cadr p1)) (setq p1 pt))))
  (progn
   (setq p1 (car lst))
   (foreach pt lst
    (if (> (cadr pt) (cadr p1)) (setq p1 pt)))))
 p1)
(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))))
(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))
[/lisp]
  • 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

Rất tuyệt vời :blink:, đúng là mở mang đc tầm mắt  :D  !!

Chỉ có 1 góp ý nho nhỏ, bác nên thêm dòng (vl-load-com) ở đầu code vì nhiều bạn ko biết lisp sẽ ko biết bổ sung vào; xoá cái râu ria "<span>" trong hàm con Cuctri thì chương trình mới chạy đ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

Rất tuyệt vời :blink:, đúng là mở mang đc tầm mắt  :D  !!

Chỉ có 1 góp ý nho nhỏ, bác nên thêm dòng (vl-load-com) ở đầu code vì nhiều bạn ko biết lisp sẽ ko biết bổ sung vào; xoá cái râu ria "<span>" trong hàm con Cuctri thì chương trình mới chạy đc :).

(vl-load-com): đánh chết cái nết không chừa... hay quên.

CV kỳ lắm. Post bài lên tự dưng sinh cái <span> ngẫu hứng. Vào edit không được (vì code lisp trống trơn), góp ý BQT hoài không thấy nhúc nhích.

Đành xóa đi code lại vậy.

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

@ Hà :

Thuật toán này ở đâu ra nhỉ ?

(* (/ Spp (+ Sp Spp)) (- (car p2) (car (Cuctri lstx))))

Hay quá mà đọc hoài chưa thông được! (kiểm tra thì cho k/quả đúng) 

Hà có thể share ý tường này?

Thanks!

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

 Hà :

Thuật toán này ở đâu ra nhỉ ?

(* (/ Spp (+ Sp Spp)) (- (car p2) (car (Cuctri lstx))))

Hay quá mà đọc hoài chưa thông được! (kiểm tra thì cho k/quả đúng) 

Hà có thể share ý tường này?

Thanks!

Cái này có thuật toán gì đâu, chỉ là biến đổi toán học dựa vào hình học thôi mà. Tôi chứng minh cho phía bên trái nhé!

67029_chia_dien_tich_2.png

  • 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

Sao bác Garupro không có ý kiến gì hết vậy?!!

 

....

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

 

@ 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

 

Bác lyky đã đề nghị bạn giải quyết lần lượt cho từng nhánh, bác đã trả lời là: "Cách này thì trước đây mình có hỏi và hiện tại đã giải quyết được" giờ lại hỏi lạ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

Chắc chủ TP bận cái gì đó quan trọng hơn lisp chứ không đến nỗi ném đá xuống hồ để xem sóng đâu! Bởi không ai ném đá xuống hồ được 2 lần.

  • 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

Sao bác Garupro không có ý kiến gì hết vậy?!!

 

 

 

 

Bác lyky đã đề nghị bạn giải quyết lần lượt cho từng nhánh, bác đã trả lời là: "Cách này thì trước đây mình có hỏi và hiện tại đã giải quyết được" giờ lại hỏi lại?

 

Xin lỗi, mấy nay bận quá không có thời gian vô TP được.

 

Cái này không phải mình hỏi lại lần hai. Thực ra mình đang làm phần mềm liên quan đến phần điều phối đất. Đến phân chia mảnh thì mình bí quá .Theo bác lyky thì chỉ dịch chuyển cái đường thẳng đứng để W1=W2 còn đường điều phối, và đoạn MN ko cố định nữa thì trước đây mình có hỏi trên CV rùi.

Bạn Song Nhi để ý cách của bạn lyky  và TP mình đưa ra hoàn toàn khác nhau mà.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Cái này có thuật toán gì đâu, chỉ là biến đổi toán học dựa vào hình học thôi mà. Tôi chứng minh cho phía bên trái nhé!

67029_chia_dien_tich_2.png

Cảm ơn bác . Thuật toán hay quá, không phải dịch chuyển để dò vị trí nữa. Nhưng mình có một thắc mắc là cái CD thì biết, vậy S1, S2, S3, S4 thì xác định kiểu gì khi mà chưa có EC

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

Cảm ơn bác . Thuật toán hay quá, không phải dịch chuyển để dò vị trí nữa. Nhưng mình có một thắc mắc là cái CD thì biết, vậy S1, S2, S3, S4 thì xác định kiểu gì khi mà chưa có EC

Không cần biết từng em S1, S2, S3, S4. Chỉ cần biết (S1+S4) và (S2+S3) là được (xem công thức của tôi ở trên). Việc xác định (S1+S4) và (S2+S3) thì chỉ là tính diện tích của hình tạo bởi 1 list points đã biết thô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

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  

×