Đến nội dung


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

[Yêu cầu] Lisp phân nhỏ tập hợp chọn bằng cách chia ô


  • Please log in to reply
102 replies to this topic

#21 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 13 June 2012 - 10:24 AM

5). "Không đè lên cái gì cả". "Cái gì" ở đây theo em hiểu là vị trí các vật thể thuộc địa hình (nhà cửa, cây cối...) chứ không kể đến các đối tượng ghi chú trên bản vẽ như dim, text, leader... thế mới đúng mục đích sử dụng.
6). "Cái gì" thực tế phải quy định gồm cả phần bên trong của miền kín chứ không chỉ là đối tượng đường. bác không thể đặt vật thể của bác vào trong lòng nhà của người ta được phải không ạ
Bài này khó quá :D
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#22 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 13 June 2012 - 10:37 AM

7). Hình như gom góp lại thì ý chủ topic là thế này thì phải: chủ topic mới tậu được 1 miếng đất, trên đó đã xây biệt thự, hồ bơi, gara và đủ thứ khác nữa. Bây giờ muốn làm thêm cái sân tennis mà không biết liệu có chỗ nào đặt được hay không? :lol:
Ái dà! Cái này chắc thuê khảo sát đi đo dễ hơn viết lisp quá! :lol:
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#23 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 June 2012 - 07:44 PM

7). Hình như gom góp lại thì ý chủ topic là thế này thì phải: chủ topic mới tậu được 1 miếng đất, trên đó đã xây biệt thự, hồ bơi, gara và đủ thứ khác nữa. Bây giờ muốn làm thêm cái sân tennis mà không biết liệu có chỗ nào đặt được hay không? :lol:
Ái dà! Cái này chắc thuê khảo sát đi đo dễ hơn viết lisp quá! :lol:

Cám ơn các bạn đã tham gia đông vui. Khi mình đưa ra một đề toán thì thường kg dễ, nếu dể mình đã làm 10 năm về trước rối. Tuy nhiên, đối với mình là khó nhưng đối với các bạn chưa hẳn vậy. Mình đã có những "thu hoạch kg ngờ" từ các bạn. Nói vui vậy thôi, mình tham gia chủ yếu để học hỏi và mở mang kiến thức, chủ yếu tạo ra đc sự hứng thú khi viết Lisp nói riêng.
Trở lại chủ đề trên, "cái gì" mình nói ở đấy là cái mà mình nhìn thấy trên màn hình (tránh những cái nhìn thấy trên màn hình), đường bao là một polyline nói chung.
Nói như bạn là rất chính xác, mình muốn làm đại khái như cái sân tennis vậy, nhưng cái việc này đo đạc cũng kg làm nhanh đc vì phải làm rất nhiều hình tương tự như vậy (bạn cần gì phải đo khi các vật thể đã có kích thước và tọa độ). Cái bạn cần phải làm là cầm một cái HCN đưa tới đưa lui rồi đặt vào chỗ trống có thể, nhưng mình cần làm việc đó tự động từ Lisp.
Nếu kg có nghiệm trả về nil. Nếu có nhiều nghiệm, trả về một vị trí là đủ (vị trí thoáng nhất càng tốt).
Mình có cảm giác, đề tài này liên quan đến bài toán chia ô vừa giải xong.
  • 0

#24 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 13 June 2012 - 08:21 PM

Lisp Check xem 1 Rectangle có thể đặt gọn vào trong 1 Curve kín hay không, với điều kiện là Rectangle không đè lên bất cứ đối tượng nào.
Chú ý: mức độ chính xác phụ thuộc số lần lặp. Để đạt chính xác càng cao thì lisp càng chạy chậm.
Bác nào có thể góp ý để lisp chạy nhanh hơn thì rất cám ơn (dù đã tìm cách khắc phục rồi).

;Doan Van Ha - CADViet.com - Ngay 13/6/2012
;Muc dich: Check xem 1 Rectangle co the nam gon trong 1 Curve kin hay khong, va Rectangle khong de len bat cu doi tuong nao trong Curve.
;Chu y: Lisp su dung tot khi Rectangle // OXY cua UCS_World. Neu Rectangle khong // thi Rotate tat ca ban ve, sau do dung lisp, roi Rotate tra lai.
(defun C:HA( / ent ent1 ent2 baoN baoT numx numy lxT lyT dx dy x y p1 p2 p3 p4 lst lst4 co)
(vl-load-com)
(while (not (setq ent1 (car (entsel "\nChon Curve bao ngoai: ")))))
(while (not (setq ent2 (car (entsel "\nChon Rectangle: ")))))
(setq baoN (LM:BoundingBox (vlax-ename->vla-object ent1))
baoT (LM:BoundingBox (vlax-ename->vla-object ent2))
lxT (distance (nth 0 baoT) (nth 1 baoT))
lyT (distance (nth 1 baoT) (nth 2 baoT))
numx 50
numy (* numx (fix (/ lxT lxT)))
dx (/ (distance (nth 0 baoN) (nth 1 baoN)) numx)
dy (/ (distance (nth 1 baoN) (nth 2 baoN)) numy)
x 0)
(princ "\nDang tinh toan. Vui long doi...\n")
(repeat numx
(setq y 0)
(repeat numy
(setq p1 (polar (polar (nth 0 baoN) (/ pi 2) (- (* y dy) (* y (/ (- lyT dy) (1- numy))))) 0 (- (* x dx) (* x (/ (- lxT dx) (1- numx)))))
p2 (polar p1 0 lxT)
p3 (polar p2 (/ pi 2) lyT)
p4 (polar p3 (- pi) lxT)
lst4 (list p1 p2 p3 p4)
ent (LWPoly lst4 1)
lst (LM:ss->ent (HA:Inside2 ent1 100 "C")))
(if (or (/= (sslength (ssget "CP" lst4)) 1) (not (member ent lst)))
(vla-Delete (vlax-ename->vla-object ent))
(setq co T))
(setq y (1+ y)))
(setq x (1+ x)))
(if co
(alert "\nDa tim duoc vi tri dat Rectangle(s). \nNhau di thoi ban oi!")
(alert "\nBuon qua di thoi. \nKhong co vi tri nao co the dat Rectangle(s)."))
(princ))
;-----
(defun LM:ss->ent (ss / i l) (if ss (repeat (setq i (sslength ss)) (setq l (cons (ssname ss (setq i (1- i))) l)))))
;----- Chän c¸c Objects bªn trong Curve, theo kiÓu "CP" hoÆc "WP".
(defun HA:Inside2 (ent num cw / i j lst)
(cond
((vlax-curve-isclosed ent)
(setq i (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) num) j (- i))
(repeat num
(setq lst (cons (vlax-curve-getpointatdist ent (setq j (+ j i))) lst)))))
(if (= (strcase cw) "C")
(ssget "cp" lst)
(ssget "wp" lst)))
;-----
(defun LM:BoundingBox (obj / ll ur)
(if (vlax-method-applicable-p obj 'GetBoundingBox)
((lambda (boundingbox)
(mapcar
(function
(lambda (_functionlist)
(mapcar
(function
(lambda (_function) ((eval _function) boundingbox)))
_functionlist)))
'((caar cadar) (caadr cadar)
(caadr cadadr) (caar cadadr))))
(mapcar 'vlax-safearray->list
(progn
(vla-getBoundingBox obj 'll 'ur) (list ll ur))))))
;----- cls=1: ®ãng; cls=0: më. (by Thai)
(defun LWPoly (lst cls)
(entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
P/S: 22h30 13/6/2012: đang update liên tục để tăng tốc độ nếu có thể.
  • 2

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


#25 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 13 June 2012 - 10:23 PM

Thật thú vị ^^ Cách giải của bác Hạ là chia ngay BoundingBox thành ô nxn, sau đó đặt HCN vào từng mút để kiểm tra. Với cách làm này thì sẽ đi lần lượt từng ô và tất nhiên đối tượng bao không nhất thiết phải kín
- Cũng có thể dùng đường Line để quét
- Cũng có thể vẫn giữ ý tưởng của bác ĐVH nhưng list tọa độ trước và bỏ đi những thằng nằm trong đối tượng con bên trong
- Cũng có thể .....
  • 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


#26 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 07:39 AM

Lisp Check xem 1 Rectangle có thể đặt gọn vào trong 1 Curve kín hay không, với điều kiện là Rectangle không đè lên bất cứ đối tượng nào.
Chú ý: mức độ chính xác phụ thuộc số lần lặp. Để đạt chính xác càng cao thì lisp càng chạy chậm.
Bác nào có thể góp ý để lisp chạy nhanh hơn thì rất cám ơn (dù đã tìm cách khắc phục rồi).


;Doan Van Ha - CADViet.com - Ngay 13/6/2012
;Muc dich: Check xem 1 Rectangle co the nam gon trong 1 Curve kin hay khong, va Rectangle khong de len bat cu doi tuong nao trong Curve.
(defun C:HA( / ent ent1 ent2 baoN baoT num lxT lyT dx dy x y p1 p2 p3 p4 lst lst4 co)
(vl-load-com)
(while (not (setq ent1 (car (entsel "\nChon Curve bao ngoai: ")))))
(while (not (setq ent2 (car (entsel "\nChon Rectangle: ")))))
(setq baoN (LM:BoundingBox (vlax-ename->vla-object ent1))
baoT (LM:BoundingBox (vlax-ename->vla-object ent2))
num 50
lxT (distance (nth 0 baoT) (nth 1 baoT))
lyT (distance (nth 1 baoT) (nth 2 baoT))
dx (/ (distance (nth 0 baoN) (nth 1 baoN)) num)
dy (/ (distance (nth 1 baoN) (nth 2 baoN)) num)
x 0)
(princ "\nDang tinh toan. Vui long doi...\n")
(repeat num
(setq y 0)
(repeat num
(setq p1 (polar (polar (nth 0 baoN) (/ pi 2) (- (* y dy) (* y (/ (- lyT dy) (1- num))))) 0 (- (* x dx) (* x (/ (- lxT dx) (1- num)))))
p2 (polar p1 0 lxT)
p3 (polar p2 (/ pi 2) lyT)
p4 (polar p3 (- pi) lxT)
lst4 (list p1 p2 p3 p4)
ent (LWPoly lst4 1)
lst (LM:ss->ent (HA:Inside2 ent1 100 "C")))
(if (or (/= (sslength (ssget "CP" lst4)) 1) (not (member ent lst)))
(vla-Delete (vlax-ename->vla-object ent))
(setq co T))
(setq y (1+ y)))
(setq x (1+ x)))
(if co
(alert "\nDa tim duoc (cac) vi tri dat Rectangle. \nNhau di thoi ban oi!")
(alert "\nBuon qua di thoi. \nKhong co vi tri nao co the dat Rectangle."))
(princ))
;-----
(defun LM:ss->ent (ss / i l) (if ss (repeat (setq i (sslength ss)) (setq l (cons (ssname ss (setq i (1- i))) l)))))
;----- Chän c¸c Objects bªn trong Curve, theo kiÓu "CP" hoÆc "WP".
(defun HA:Inside2 (ent num cw / i j lst)
(cond
((vlax-curve-isclosed ent)
(setq i (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) num) j (- i))
(repeat num
(setq lst (cons (vlax-curve-getpointatdist ent (setq j (+ j i))) lst)))))
(if (= (strcase cw) "C")
(ssget "cp" lst)
(ssget "wp" lst)))
;-----
(defun LM:BoundingBox ( object / lowerleft upperright )
(if (vlax-method-applicable-p object 'GetBoundingBox)
((lambda ( boundingbox )
(mapcar
(function
(lambda (_functionlist)
(mapcar
(function
(lambda (_function ) ((eval _function) boundingbox)))
_functionlist)))
'((caar cadar) (caadr cadar)
(caadr cadadr) (caar cadadr))))
(mapcar 'vlax-safearray->list
(progn
(vla-getBoundingBox object 'lowerleft 'upperright) (list lowerleft upperright))))))
;----- cls=1: ®ãng; cls=0: më. (by Thai)
(defun LWPoly (lst cls)
(entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))
P/S: 22h30 13/6/2012: đang update liên tục để tăng tốc độ nếu có thể.

Giải pháp dùng BoundingBox chỉ áp dụng cho rectang nằm ngang (vuông góc với trục tọa độ).

T/hợp rectang không vuông góc với trục tọa độ thì chưa tính hết các t/hợp có thể có.
  • 0

#27 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 08:24 AM

Nếu cần thì thêm dòng chuyển UCS nữa.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#28 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 08:43 AM

Nếu cần thì thêm dòng chuyển UCS nữa.

Đổi tọa độ cũng chỉ áp dụng đuợc cho t/hợp chỉ tịnh tiến (move) rectang.

T/hợp quay rectang (rotate) thì ...?

PS : Tôi chỉ nêu bài toán tổng quát, không biết chủ topic có yêu cầu như thế không nữa ?!
  • 1

#29 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 09:49 AM

Cám ơn bác Gia_Bach về phát hiện này. Trước mắt, nếu Rectangle nằm ở vị trí đặc biệt thì chắc phải Rotate tất cả bản vẽ, rồi dùng lisp, sau đó Rotate trở lại.
Đang nghĩ xem có phương án nào tốt hơn không.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#30 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 June 2012 - 02:32 PM

Cám ơn bác Gia_Bach về phát hiện này. Trước mắt, nếu Rectangle nằm ở vị trí đặc biệt thì chắc phải Rotate tất cả bản vẽ, rồi dùng lisp, sau đó Rotate trở lại.
Đang nghĩ xem có phương án nào tốt hơn không.

@Gia_Bach : Nếu xét cả TH tổng quá thì rất tốt, tuy nhiên thấy hơi khó nên mình chưa đưa ra.
Đã test code của bác Ha, cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều, bác có thể nói rõ hơn phương pháp của bác để xem mình có góp ý đc gì để cải tiến tốc độ kg
  • 0

#31 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 14 June 2012 - 08:42 PM

@Gia_Bach : Nếu xét cả TH tổng quá thì rất tốt, tuy nhiên thấy hơi khó nên mình chưa đưa ra.
Đã test code của bác Ha, cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều, bác có thể nói rõ hơn phương pháp của bác để xem mình có góp ý đc gì để cải tiến tốc độ kg

Thật thú vị ^^ Cách giải của bác Hạ là chia ngay BoundingBox thành ô nxn, sau đó đặt HCN vào từng mút để kiểm tra. Với cách làm này thì sẽ đi lần lượt từng ô và tất nhiên đối tượng bao không nhất thiết phải kín


  • 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


#32 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 14 June 2012 - 09:32 PM

@Gia_Bach : Nếu xét cả TH tổng quá thì rất tốt, tuy nhiên thấy hơi khó nên mình chưa đưa ra.
Đã test code của bác Ha, cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều, bác có thể nói rõ hơn phương pháp của bác để xem mình có góp ý đc gì để cải tiến tốc độ kg

Hề hề hề,
Đây là lisp mình thử làm theo cách củ chuối nhất nên khá chậm. Tuy nhiên cũng có được kết quả. Để tăng tốc độ lisp thì mình thấy hơi khó do sử dụng việc quét qua lưới điểm theo khoảng cách do người dùng tự chọn và nhập vào.
Nguyên tắc giải thuật của mình là, từ vùng chọn offset theo 1/2 kích thước nhỏ của hình chữ nhật để lấy vùng tâm có thể của hình chữ nhật đặt vào. Tạo một lưới điểm với khoảng cách được người dùng lựa chọn. (nếu muốn nhanh có thể tăng khoảng cách này một cách hợp lý). Từ lưới điểm này lần lượt copy và rotate HCN về mỗi điểm trên lưới. Số bước quay ở đây phụ thuộc vào biến lệch. Tùy người dùng có thể điều chỉnh giá trị của biến này để có được kết quả nhanh hơn. Tiếp theo kiểm tra xem HCN này có chứa đối tượng nào hay không và xử lý.
Kết quả trả về một list các tọa độ của các HCN có thể đặt được trong vùng chọn.
Từ list này vẽ lại các HCN đó.
Lisp:


(defun c:arr ( / oldos en pls h d en0 a pg en1 plst ssdt b xlst ylst xmin xmax ymin ymax kc ssp pls2 pls1
goc lech plst1 )
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)

(setq en (car (entsel "\n Chon doi tuong polyline goc" )))
(setq pls (acet-geom-vertex-list en)
h (distance (nth 0 pls) (nth 1 pls))
d (distance (nth 1 pls) (nth 2 pls)) )
(command "copy" en "" (nth 3 pls) (nth 3 pls))
(setq en0 (entlast))
(command "undo" "be")
(command "region" en "")
(setq a (entlast))
(setq pg (vlax-safearray->list (vlax-variant-value (vlax-get-property (vlax-ename->vla-object a) 'centroid ))) )
;;;;(setq pg (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object a)))))

(setq en1 (car (entsel "\n Chon polyline duong bao"))
plst (acet-geom-vertex-list en1)
ssdt (acet-ss-to-list (ssget "wp" plst (list (cons 0 "lwpolyline") (cons 70 1))))
)
(command "offset" (/ (min h d) 2) en1 (getpoint "\n Pick diem trong vung chon") "")
(setq b (entlast)
plst (acet-geom-vertex-list B)
xlst (vl-sort (mapcar '(lambda (x) (car x)) plst) '<)
ylst (vl-sort (mapcar '(lambda (x) (cadr x)) plst) '<)
xmin (car xlst) xmax (last xlst) ymin (car ylst) ymax (last ylst)
kc (getreal "\n Nhap khoang cach toi thieu giua hai doi tuong: ")
xlst (list xmin) ylst (list ymin) )
(while (<= xmin xmax)
(setq xmin (+ xmin (/ kc 2))
xlst (append xlst (list xmin)) )
)
(while (<= ymin ymax)
(setq ymin (+ ymin (/ kc 2))
ylst (append ylst (list ymin)) )
)
(setq xlst (append xlst (list xmax))
ylst (append ylst (list ymax)) )

(foreach x xlst
(foreach y ylst
(setq pls1 (append pls1 (list (list x y 0.0))))
(command "point" (list x y 0.0))
)
)

(setq ssp (acet-ss-to-list (ssget "cp" plst (list (cons 0 "point")))))
(setq pls2 (list))
(foreach p ssp
(setq pls2 (append pls2 (list (cdr (assoc 10 (entget p))))) )
)
;;;;(command "region" en1 "")
;;;;(setq b (entlast))
;;;;(foreach s ssdt
;;;(command "region" s "")
;;; (setq c (entlast))
;;;(command "subtract" b "" c "")
;;;(setq b (entlast) )
;;;)
;;;;;(command "boundary" (getpoint "\n Pick diem trong vung chon") "")
;;;;;(setq b (entlast)
;;;;;plst (acet-geom-vertex-list B) )

(command "undo" "e")
(command "undo" 1)
(command "undo" "be")
(setq goc 0 lech 10
plst1(list) )
(foreach p pls2
(while (< goc 180)
(command "copy" en0 "" pg p)
(setq b (entlast))
(command "rotate" b "" p goc)
(setq b (entlast)
pls (acet-geom-vertex-list B)
n (sslength (ssget "cp" pls)) )
(if (> n 1)
(command "erase" b "")
(progn
(setq plst1 (append plst1 (list pls)))
(command "erase" b "")
)
)
(setq goc (+ goc lech))
)
(setq goc 0)
)
(foreach lst plst1
(acet-pline-make (list lst))
)
(command "undo" "e")
(setvar "osmode" oldos)
(princ)

)

Đây là hình ảnh kết quả sau khi chạy lisp với khoảng cách lưới là 4/2=2 và giá trị biến lệch là 10 như trong lisp. Thời gian chạy mất 60 phút.
Hình đã gửi

Rất mong mọi người góp ý thêm.
Khi tăng khoảng cách lưới điểm là 8/2=4 thì lisp chỉ chạy mất 6 phút nhưng kết quả cho ra ít hơn khá nhiều.
  • 2
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#33 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 09:57 PM

Mệt! Câu đầu tiên phải nói là mệt! Và quá mệt!
Vài lời tâm sự khi viết xong lisp này:
1). Cám ơn bác Gia_Bach đã phát hiện hàm LM:BoundingBox của Lee Mac.
2). Cám ơn Ketxu đã động viện bằng 3 từ "thật thú vị".
3). Cám ơn tất cả mọi người đã quan tâm.
4). Buồn lắm khi người viết thì "P/S: 22h30 13/6/2012: đang update liên tục để tăng tốc độ nếu có thể." nhưng chủ topic thì "Đã test code của bác Ha, cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều".
5). Để làm được cái lisp đó tôi phải mất nửa ngày, và test trên máy của mình thì mất tầm 30".
6). "bác có thể nói rõ hơn phương pháp của bác để xem mình có góp ý đc gì để cải tiến tốc độ kg". Câu này khó hiểu quá.
7). Tôi ao ước tổng quát hoá bài toán: boundary là 1 curve và rectangle cũng là curve luôn. Và đã làm được, nhưng chạy chậm lắm.
8). Tìm ra giải thuật để giải bài toán của chủ topic đã khó, tìm thêm giải thuật để đẩy nhanh tốc độ càng khó hơn.
9). Cuối cùng, là điều an ủi: viết xong lisp này thì học hỏi được nhiều điều (test bản vẽ trên máy mình thì mất tầm 5-10").

;Doan Van Ha - CADViet.com - Ngay 13-14/6/2012
;Muc dich: Check xem Curve_closed co the chua 1 Rectangle hay khong, biet Rectangle khong de len bat cu doi tuong nao trong Curve.
;Co the mo rong de xet Curve nam trong Curve, nhung lisp se chay cham hon.
(defun C:HA( / entN entT baoN baoT lstT lstN nx ny lxT lyT dx dy x y lstN lstT ttT hso co ptt lstTi)
(vl-load-com)
(while (not (setq objN (vlax-ename->vla-object (setq entN (car (entsel "\nChon Curve bao ngoai: ")))))))
(while (not (setq objT (vlax-ename->vla-object (setq entT (car (entsel "\nChon Rectangle: ")))))))
(setq baoN (LM:BoundingBox objN)
baoT (LM:BoundingBox objT)
lstN (LISTP_CURVE objN 100)
lstT (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget entT)))
ttT (TTC objT)
lxT (distance (nth 0 baoT) (nth 1 baoT))
lyT (distance (nth 1 baoT) (nth 2 baoT))
nx 50
ny (* nx (fix (/ lxT lxT)))
dx (/ (distance (nth 0 baoN) (nth 1 baoN)) nx)
dy (/ (distance (nth 1 baoN) (nth 2 baoN)) ny)
hso (- (sslength (ssget "CP" baoN)) (sslength (ssget "CP" lstN)))
x 0)
(princ "\nDang tinh toan. Vui long doi...\n")
(repeat nx
(setq y 0)
(repeat ny
(setq ptt (polar (polar (nth 0 baoN) (/ pi 2) (- (* y dy) (* y (/ (- lyT dy) (1- ny))))) 0 (- (* x dx) (* x (/ (- lxT dx) (1- nx))))))
(setq lstTi (CTD lstT ttT ptt))
(if (= nil (ssget "CP" lstTi))
(progn
(LWPoly lstTi 1)
(if (/= (- (sslength (ssget "CP" baoN)) (sslength (ssget "CP" lstN))) hso)
(vla-delete (vlax-ename->vla-object (entlast)))
(setq co T))))
(setq y (1+ y)))
(setq x (1+ x)))
(if co
(alert "\nDa tim duoc vi tri dat Rectangle(s). \nNhau di thoi ban oi!")
(alert "\nBuon qua di thoi. \nKhong co vi tri nao co the dat Rectangle(s)."))
(princ))
;----- Get Centroid of Curve.
(defun TTC (obj / tt)
(cond
((= (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "REGION")
(setq tt (vlax-get obj 'Centroid)))
((wcmatch (cdr (assoc 0 (entget (vlax-vla-object->ename obj)))) "CIRCLE,ELLIPSE,POLYLINE,LWPOLYLINE,SPLINE")
(setq tt (vlax-get (car (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'addregion (list obj))) 'Centroid))
(entdel (entlast))))
tt)
;-----
(defun CTD (lst p1 p2 / lst1)
(foreach n lst
(setq lst1 (cons (polar n (angle p1 p2) (distance p1 p2)) lst1)))
lst1)
;----- Get list points of Curve (*Line, Arc) theo s&#232; l&#173;&#238;ng (num) point. by HA.
(defun LISTP_CURVE (obj num / step dis lst)
(setq step (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)) (1- num))
dis 0)
(repeat (1- num)
(setq lst (cons (vlax-curve-getPointAtDist Obj dis) lst)
dis (+ step dis)))
(reverse (cons (vlax-curve-getEndPoint Obj) lst)))
;----- Ch&#228;n c&#184;c Objects b&#170;n trong Curve closed, theo ki&#211;u "CP" ho&#198;c "WP".
(defun HA:Inside2 (ent num cw / i j lst)
(setq i (/ (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) num) j (- i))
(repeat num
(setq lst (cons (vlax-curve-getpointatdist ent (setq j (+ j i))) lst)))
(if (= (strcase cw) "C")
(ssget "cp" lst)
(ssget "wp" lst)))
;-----
(defun LM:BoundingBox (obj / ll ur)
(if (vlax-method-applicable-p obj 'GetBoundingBox)
((lambda (boundingbox)
(mapcar
(function
(lambda (_functionlist)
(mapcar
(function
(lambda (_function) ((eval _function) boundingbox)))
_functionlist)))
'((caar cadar) (caadr cadar)
(caadr cadadr) (caar cadadr))))
(mapcar 'vlax-safearray->list
(progn
(vla-getBoundingBox obj 'll 'ur) (list ll ur))))))
;----- cls=1: &#174;&#227;ng; cls=0: m&#235;. (by Thai)
(defun LWPoly (lst cls)
(entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))))

  • 2

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


#34 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 14 June 2012 - 10:52 PM

Mệt! Câu đầu tiên phải nói là mệt! Và quá mệt!
Vài lời tâm sự khi viết xong lisp này:
1). Cám ơn bác Gia_Bach đã phát hiện hàm LM:BoundingBox của Lee Mac.
2). Cám ơn Ketxu đã động viện bằng 3 từ "thật thú vị".
3). Cám ơn tất cả mọi người đã quan tâm.
4). Buồn lắm khi người viết thì "P/S: 22h30 13/6/2012: đang update liên tục để tăng tốc độ nếu có thể." nhưng chủ topic thì "Đã test code của bác Ha, cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều".
5). Để làm được cái lisp đó tôi phải mất nửa ngày, và test trên máy của mình thì mất tầm 30".
6). "bác có thể nói rõ hơn phương pháp của bác để xem mình có góp ý đc gì để cải tiến tốc độ kg". Câu này khó hiểu quá.
7). Tôi ao ước tổng quát hoá bài toán: boundary là 1 curve và rectangle cũng là curve luôn. Và đã làm được, nhưng chạy chậm lắm.
8). Tìm ra giải thuật để giải bài toán của chủ topic đã khó, tìm thêm giải thuật để đẩy nhanh tốc độ càng khó hơn.
9). Cuối cùng, là điều an ủi: viết xong lisp này thì học hỏi được nhiều điều (test bản vẽ trên máy mình thì mất tầm 5-10").

Hề hề hề,
Minh test thử lisp của bác thì thấy nó chạy cũng khá nhanh. Tuy nhiên lisp chỉ trả ra kết quả một vị trí duy nhất.
Nếu chỉ xét vị trí của HCN tịnh tiến thì lisp của minh chạy cũng khá ổn, (tuong đương với tốc độ lisp của bác), tuy kết quả có khác nhau tí đỉnh.
Mình chưa đọc kỹ lisp của bác song thấy nó khá là khó vì bác dùng khá nhiều hàm vla, vlax ... là cái mà minh còn chưa thủng lắm.
Hy vọng mình sẽ hiểu rõ hơn khi có thời gian để ngâm cứu nó.
Chúc bác luôn mạnh và vui.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#35 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 June 2012 - 11:00 PM

Bài toán này nếu đã có 1 nghiệm thì sẽ có vô số nghiệm. Bác có tìm ra N nghiệm thì nó vẫn còn vô số nghiệm khác. Cho nên chỉ đưa ra 1 nghiệm trong 1 vùng lân cận của rectangle thôi.
Nếu bác xoá trống hết thì nó chỉ ra nhiều nghiệm trong nhiều vùng đấy bác ạ.
Còn nếu chủ topic đòi hỏi chỉ ra tất cả nghiệm thì thật vô nghĩa.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#36 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 14 June 2012 - 11:56 PM

:lol: Mình đã thấy ngay từ đầu là bài toán này là nếu có làm được thì việc làm đó cũng vô nghĩa bởi đúng như bác TRUNGNGAMY nhận xét: "cách tìm vị trí thì OK nhưng chạy chậm hơn làm bằng tay nhiều" Vậy mà bác cứ ham hố giờ kêu chán.

Bác cứ thử giả thiết nếu công việc của bác gặp phải vấn đề như trên, liệu khi đó bác có nghĩ rằng mình cần viết lisp để làm công việc này hay không? hay tốt hơn là bằng cảm quan, bằng con mắt nghề nghiệp của mình là bác đã tự có thể nhận ra việc liệu có thể đặt được vật thể đó, và nếu đặt được thì đặt ở đâu cho hợp lý nhất. Máy móc không làm thay chúng ta việc này được đâu.

Thêm nữa. khi code chạy quá chậm, thay vì cố gắng đến mệt mỏi để sửa thuật toán thì sao bác không nghĩ rằng có thể thay đổi đề bài để ra kết quả nhanh hơn? Với bài toán này hoàn toàn có thể làm được điều đó bằng cách khoanh vùng và loại bỏ những miền chắc chắn ko thể đặt được vật thể trước khi chạy code. :rolleyes:

@Bác DVH: vài dòng nhận xét mong bác không tự ái.
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#37 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 15 June 2012 - 12:00 AM

Thử chạy lisp và thử làm lisp là cách tốt nhất để nhận ra mọi điều.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#38 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 June 2012 - 03:25 AM

@ bác Ha : Đã test thử lisp mới của bác Ha, chỉ mất 3", một cải tiến đáng nể. Tuy nhiên, trong một hình khác thì nó lại báo kg tìm đc vị trí mặc dù có nghiệm. Nếu bạn còn hơi thì mình gởi file để bạn hoàn thiện tiếp, xong rồi lúc nào có dịp thì nhậu xả hơi vậy.
@ bác Bình : đã test nhưng chưa ra kq như mong muốn.
Cám ơn tất cả các bác và thật là có lỗi vì để các bác tổn hao tâm trí quá nhiều.
Có lẽ phải chờ một phương pháp đột phá hơn nữa.
Thấy các bạn có vẻ nản rồi, nếu các bạn hết hứng thú thì phải tạm xếp lại chờ vậy.
Tuy nhiên, mình thử nêu ý kiến của mình xem các bạn có thể kg
- Tạo HCN bao của polyline.
- Chia thành lưới ô vuông nhỏ, lập một ma trận vuông 2 chiều để quản lý các ô vuông này.
- Lần lượt chạy qua các ô và kiểm tra. Đánh dấu =0 nếu ô nằm ngoài polyline hay có vật cản, đánh đấu =1 khi ô nằm trong và trống rỗng.
- Vị trí cần tìm chính là nơi tập trung nhiều ô trống kề nhau nhất, chỉ cần kiếm tra vùng này thôi .
Ý tưởng là vậy, nhưng viết CT thì ... chịu
-
  • 0

#39 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 15 June 2012 - 03:51 AM

@ bác Ha : Đã test thử lisp mới của bác Ha, chỉ mất 3", một cải tiến đáng nể. Tuy nhiên, trong một hình khác thì nó lại báo kg tìm đc vị trí mặc dù có nghiệm.
@ bác Bình : đã test nhưng chưa ra kq như mong muốn.
Cám ơn tất cả các bác và thật là có lỗi vì để các bác tổn hao tâm trí quá nhiều.
Có lẽ phải chờ một phương pháp đột phá hơn nữa.
Nếu các bạn hết hứng thú thì phải tạm xếp lại chờ vậy.
Tuy nhiên, mình thử nêu ý kiến của mình xem các bạn có thể kg
- Tạo HCN bao của polyline.
- Chia thành lưới ô vuông nhỏ, lập một ma trận vuông 2 chiều để quản lý các ô vuông này.
- Lần lượt chạy qua các ô và kiểm tra. Đánh dấu =0 nếu ô nằm ngoài polyline hay có vật cản, đánh đấu =1 khi ô nằm trong và trống rỗng.
- Vị trí cần tìm chính là nơi tập trung nhiều ô trống kề nhau nhất, chỉ cần kiếm tra vùng này thôi .
Ý tưởng là vậy, nhưng viết CT thì ... chịu
-

Hế hề hế,
Bác có thể cho biết rõ hơn nó cho ra cái kết quả thế nào không ạ??? Mình đã test trên bản vẽ bác gửi thì thấy Ok như hình đã post mà....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#40 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 15 June 2012 - 06:30 AM

@ bác Ha : Đã test thử lisp mới của bác Ha, chỉ mất 3", một cải tiến đáng nể. Tuy nhiên, trong một hình khác thì nó lại báo kg tìm đc vị trí mặc dù có nghiệm. Nếu bạn còn hơi thì mình gởi file để bạn hoàn thiện tiếp, xong rồi lúc nào có dịp thì nhậu xả hơi vậy.
...
Tuy nhiên, mình thử nêu ý kiến của mình xem các bạn có thể kg
- Tạo HCN bao của polyline.
- Chia thành lưới ô vuông nhỏ, lập một ma trận vuông 2 chiều để quản lý các ô vuông này.
- Lần lượt chạy qua các ô và kiểm tra. Đánh dấu =0 nếu ô nằm ngoài polyline hay có vật cản, đánh đấu =1 khi ô nằm trong và trống rỗng.
- Vị trí cần tìm chính là nơi tập trung nhiều ô trống kề nhau nhất, chỉ cần kiếm tra vùng này thôi .
Ý tưởng là vậy, nhưng viết CT thì ... chịu
-

1). Ý tưởng của bạn gần trùng với ý tưởng đã viết trong lisp.
2). Bạn gởi cái bản vẽ đó lên. Bây giờ nếu có sự cố thì chỉ sửa chút thôi.
P/S (14h50 15/6/2012): cách giải bài toán tổng quát xem link ở đây:
http://www.cadviet.c...=0
  • 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.