Đế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

#61 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 21 June 2012 - 12:04 AM

Viết lisp đạt tốc độ cao thì bao giờ cũng khó. Rất chờ đợi những sáng tạo xuất thần của bác. Nếu phân tích thì như bác Thai đã phân tích, và có thể bổ sung thêm một vài thứ nữa. Dù sao tôi vẫn thích những vấn đề mà bác đã đưa ra. Chỉ tiếc là nếu bác nói đề toán là "đố vui" hoặc "thảo luận" thì mọi việc sẽ nhẹ nhàng hơn.
Tôi cũng góp 1 cái (thay lời phân tích), giải đố để giải trí cho vui. Chạy trên bản vẽ bác gởi (#54), trên máy tui, trên cad2007, thì mất tầm 15".


(vl-load-com)
(defun C:HA ( / ss )
(foreach x (GIAOSS (ssget))
(entmake (list (cons 0 "POINT") (cons 10 x))))
(princ))
(defun GIAOSS (ss / a i j objlst lst)
(setq i (sslength ss))
(setq objlst (SS->objlst ss))
(while (> (setq j (1- i) i (1- i)) -1)
(setq a (nth i objlst))
(while (> (setq j (1- j)) -1)
(setq lst (cons (NHOM3 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))))
(apply 'append lst))
(defun NHOM3 (lst / a B)
(while lst
(repeat 3
(setq a (cons (car lst) a) lst (cdr lst)))
(setq b (cons (reverse a) B) a nil)) (reverse B))
(defun SS->objlst (ss / i lst)
(repeat (setq i (sslength ss))
(setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))

Của bạn chạy trên máy mình mất 9''
Mình đang làm cái việc sưu tầm, đúc kết, vận dụng những Lisp hay của các bạn, nên những sáng tạo xuất thần là của các bạn chứ kg phải của mình. Có lẽ bạn hiểu nhầm câu nói ở trên của mình. Kg mấy khi mình sưu tầm đc những Lisp hay như vậy nên mình sẽ viết 1 vài Lisp vận dụng nó cho các bạn thấy nó hay như thế nào thôi.
  • 0

#62 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 21 June 2012 - 09:28 AM

Cám ơn bạn Ha đã hỗ trợ hết mình. Hôm nay mình có vđ này nhờ các bạn thử xem. Do đây kg phải là một ý tưởng bị bí nên mình kg đưa thành một chủ đề. Vđ thế này : Mình có down trên DD Cadviet một Lisp kg rõ của bạn nào (xin thứ lỗi), nó có chức năng tìm giao điểm của các đoạn thẳng (và nhiều loại đường khác) và đánh vào đó một Block, tuy nhiên, mình thay vào đó 1 point cho nó nhanh. Hiện tại nó chạy với bv mình đưa lên dưới đấy mất 3'43'', bạn nào có thể sd Lisp này và nâng cấp sao cho nó có thể chạy dưới 20''. Xin các bạn thử xem, đây là một vđ cải thiện tốc độ. Cám ơn các bạn.

Hi NgaMy, lâu quá khg vào diễn đàn, thiep xin góp 1 lisp để giải trí, giải sầu một tí:

(defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len r p1 p2 p3 p4
lstF ss)
(setq TapChon (ssget '((0 . "*LINE")))
entlst (ACET-SS-TO-LIST TapChon)
lst nil
)
(command "undo" "be")
(setvar "osmode" 0)
(foreach ent entlst
(setq Pstart (vlax-curve-getStartPoint ent)
Pend (vlax-curve-getEndPoint ent)
)
(setq lst (append lst (list Pstart) (list Pend)))
)
(setq lst (ACET-LIST-REMOVE-DUPLICATES lst 0.01));
(setq len (length lst)
r 0.01)
(foreach Diem lst
(setq p1 (polar Diem 0 r)
p2 (polar Diem (/ pi 2) r)
p3 (polar Diem pi r)
p4 (polar Diem (/ (* 3 pi) 2) r)
lstF (list p1 p2 p3 p4)
)
(setq ss (ssget "F" lstF '((0 . "*LINE"))))
(if (and ss (> (sslength ss) 1))
(entmake (list (cons 0 "POINT") (cons 10 Diem)))
)
)
)
(command "undo" "en")
(princ len)
)
thời gian chạy 0.43"
  • 0

#63 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 21 June 2012 - 10:35 AM

Hi NgaMy, lâu quá khg vào diễn đàn, thiep xin góp 1 lisp để giải trí, giải sầu một tí:


(defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len r p1 p2 p3 p4
lstF ss)
(setq TapChon (ssget '((0 . "*LINE")))
entlst (ACET-SS-TO-LIST TapChon)
lst nil
)
(command "undo" "be")
(setvar "osmode" 0)
(foreach ent entlst
(setq Pstart (vlax-curve-getStartPoint ent)
Pend (vlax-curve-getEndPoint ent)
)
(setq lst (append lst (list Pstart) (list Pend)))
)
(setq lst (ACET-LIST-REMOVE-DUPLICATES lst 0.01));
(setq len (length lst)
r 0.01)
(foreach Diem lst
(setq p1 (polar Diem 0 r)
p2 (polar Diem (/ pi 2) r)
p3 (polar Diem pi r)
p4 (polar Diem (/ (* 3 pi) 2) r)
lstF (list p1 p2 p3 p4)
)
(setq ss (ssget "F" lstF '((0 . "*LINE"))))
(if (and ss (> (sslength ss) 1))
(entmake (list (cons 0 "POINT") (cons 10 Diem)))
)
)
)
(command "undo" "en")
(princ len)
)
thời gian chạy 0.43"

Chào Thiep! Hình như ban đã sd điểm đầu và cuối để chèn cái point vào, điều này kg đúng yêu cầu. Bạn phải tìm điểm giao của chúng. Vì mình lười kg đưa một bv khác nên làm bạn hiểu nhầm. Vì bv này tất cà các line đều nối với nhau nhưng nếu mình đưa 1 bv khác thì Lisp của bạn sẽ chạy sai. Với lại 1 điểm giao bạn chỉ insert 1 point mà thôi
  • 0

#64 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 21 June 2012 - 12:22 PM

Chào Thiep! Hình như ban đã sd điểm đầu và cuối để chèn cái point vào, điều này kg đúng yêu cầu. Bạn phải tìm điểm giao của chúng. Vì mình lười kg đưa một bv khác nên làm bạn hiểu nhầm. Vì bv này tất cà các line đều nối với nhau nhưng nếu mình đưa 1 bv khác thì Lisp của bạn sẽ chạy sai. Với lại 1 điểm giao bạn chỉ insert 1 point mà thôi

Hi NgaMy, bạn cho 1 BV ví dụ trường hợp các line không gặp nhau tại endpoint hay startpoint đi. Sẽ có trường hợp các line cắt nhau và không cắt nhau, lúc này tìm điểm giao sẽ mênh mông lắm. Tại vị trí 3 line chụm đầu vào nhau mà đều cắt nhau, sẽ có trường hợp tìm được 3 điểm giao. Tại vị trí 3 line chụm đầu vào nhau mà không cắt nhau, giả sử có khoảng hở max là 0.5, sẽ có trường hợp tìm được 3 điểm giao mở rộng, lúc này biết lấy điểm nào?
Lisp của thiep ở trên đã thực hiện với mỗi 1 điểm giao thì insert 1 point rồi mà
  • 0

#65 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 12:48 PM

Lisp của bác Thiep về nguyên lý thì chắc chắn sẽ chạy chính xác. thay "c" bằng "f" giúp loại bỏ hoàn toàn các đối tượng không giao với đối tượng đang xét => giảm đáng kể số vòng lặp.
Tuy nhiên phải thực hiện zoom extend đến đối tượng trước khi chọn (ssget "f") không là có thể bị chọn thiếu đối tượng ngay. sử dụng ssget ức chế nhất điều này.
Mình có ý kiến thêm 1 chút là cần fải kiểm soát các vị trí điểm giao đã tìm thấy, tránh trường hợp a giao với b rồi đến lần lặp sau lại b giao với a.
  • 0

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


#66 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 June 2012 - 01:26 PM

Mình có ý kiến thêm 1 chút là cần fải kiểm soát các vị trí điểm giao đã tìm thấy, tránh trường hợp a giao với b rồi đến lần lặp sau lại b giao với a.

E tưởng là kiểu gì các bác cũng phải làm như thế này chứ ^^ Hình như trong các lisp Break All đều sử dụng
  • 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


#67 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 02:28 PM

Lisp cũ đã loại trường hợp a giao b rồi b giao a, nhưng chưa loại các trường kiểu như a giao b, b giao c, rồi c giao a...
Cám ơn 2 góp ý trên, và đã bổ sung để loại tất cả trường hợp có điểm giao trùng nhau (=> lisp có thể chạy nhanh hơn). Vẫn link cũ.
  • 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.


#68 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 02:38 PM

Các bác ghi kết quả là 3 hay 5 giây, nhưng không có chuẩn thì sao mà biết là chậm hay nhanh ?!
(vì cấu hình máy tính của mỗi nguời khác nhau).

Góp vui với các bác :

(defun C:test(/ ipts lst obj ss)
(defun ss2lstObj (ss / n l e)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))) )

(if (and (setq ss(ssget "_A"(list (cons 0 "LINE"))))
(> (sslength ss)1))
(progn
(setq start (getvar "millisecs"))
(setq lst (ss2lstObj ss) )
(while (> (length lst)1)
(setq obj (car lst) lst (cdr lst))
(foreach e lst
(if (setq iPts (vlax-Invoke obj "IntersectWith" e 0))
(entmake (list (cons 0 "POINT") (cons 10 iPts))) )))
(princ (/(- (getvar "millisecs") start)1000.0)) (princ " giay.")))
(princ) )

  • 2

#69 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 02:46 PM

Bác Gia_Bach cũng quên như tôi đã từng quên (và tôi đã sửa lại rồi) là: không loại trừ các trường hợp có nhiều hơn 2 đường giao nhau tại cùng 1 điểm.
  • 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.


#70 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 21 June 2012 - 03:40 PM

P/S (14h15' - 21/6/2012): bổ sung thêm phần loại bỏ các điểm giao trùng nhau.

Mất 15'' bác Ha ạ.
@ Thiep : Lisp của bạn vẫn còn lỗi cú pháp, bạn xem lại giúp nhé
Thiep kg cần loại bỏ các kc có ss 0.5. Vì trên bv đó kg có TH như vậy. Chỉ cần khác 0.002m thì xem như là 0 trùng, cứ thoải mái insert vào đó 1 point
  • 1

#71 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 21 June 2012 - 03:53 PM

Các bác ghi kết quả là 3 hay 5 giây, nhưng không có chuẩn thì sao mà biết là chậm hay nhanh ?!
(vì cấu hình máy tính của mỗi nguời khác nhau).

Góp vui với các bác :


(defun C:test(/ ipts lst obj ss)
(defun ss2lstObj (ss / n l e)
(setq n (sslength ss))
(while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (vlax-ename->vla-object e) l))) )

(if (and (setq ss(ssget "_A"(list (cons 0 "LINE"))))
(> (sslength ss)1))
(progn
(setq start (getvar "millisecs"))
(setq lst (ss2lstObj ss) )
(while (> (length lst)1)
(setq obj (car lst) lst (cdr lst))
(foreach e lst
(if (setq iPts (vlax-Invoke obj "IntersectWith" e 0))
(entmake (list (cons 0 "POINT") (cons 10 iPts))) )))
(princ (/(- (getvar "millisecs") start)1000.0)) (princ " giay.")))
(princ) )

Mất 8''4 bạn ạ
Các bạn lưu ý việc kg ghi trùng vào điểm đã có chỉ mang tính tương đối, chúng ta tạm chấp nhận là khi sd hàm assoc hoặc member hay các hàm tương đương với đối số là tọa độ điểm kiểm tra mà trả về nil thì xem như điểm này chưa có, có thể chèn vào đó 1 point. Tuy nhiên, việc xét như vậy là chưa chính xác đối với số thập phân. Nó chỉ cx khi các bạn đổi ra kiểu int hoặc string
  • 0

#72 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 21 June 2012 - 04:19 PM

Mất 15'' Ha ơi.
@ Thiep : Lisp của bạn vẫn còn lỗi cú pháp, bạn xem lại giúp nhé
Thiep kg cần loại bỏ các kc có ss 0.5. Vì trên bv đó kg có TH như vậy. Chỉ cần khác 0.002m thì xem như là 0 trùng, cứ thoải mái insert vào đó 1 point

Nếu mình sd code của bác Ha rồi lồng vào thân code mình cải tiến thêm thì chỉ mất 0.796 giay (theo cách tình thời gian của Gia_Bach).
Như vậy trong khi các bạn chưa xuống mức 3'' (theo máy của mình) thì mình đã hạ xuống dưới 1'' rồi. Nhưng lưu ý một điều mình toàn sd code của các bạn, nếu chưa cx thì sẽ cùng nhau bàn bạc sau về vđ 1 điểm chèn 1 point.
Mình chưa hiểu code của Gia_Bach lắm nên chưa vận dụng đc, có lẽ nó còn thấp hơn nữa
  • 1

#73 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 04:42 PM

Bạn down lại và chạy xem (có bổ sung hàm đếm giây). Máy tôi mất 5".
Lisp của bác Gia_bach như tôi đã nói ở phần trên là bị thừa rất nhiều điểm trùng nhau, do đó cần phải bổ sung hàm để loại bỏ sự trùng nhau nữa. Nếu sau khi vẽ points mà tổng số đối tượng trên bản vẽ là 1926 mới đúng.
Nếu chỉ mất <1" thì post lên để ngâm cứu và học hỏi.
  • 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.


#74 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 21 June 2012 - 07:27 PM

Bác Gia Bach cho em hỏi chút. (ssget "_A") có khác gì (ssget "_X") không? em chạy thử nhưng không nhận thấy điều gì khác biệt giữa 2 sel-method này.
  • 0

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


#75 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 21 June 2012 - 07:30 PM

http://www.cadviet.c...ndpost&p=168847


@Các bác và bác TRUNGNGAMY : chủ đề ngày càng đi xa tiêu đề. Trong 1 topic đã có 3 vấn đề hoàn toàn khác nhau
  • 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


#76 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 21 June 2012 - 10:40 PM

http://www.cadviet.c...ndpost&p=168847


@Các bác và bác TRUNGNGAMY : chủ đề ngày càng đi xa tiêu đề. Trong 1 topic đã có 3 vấn đề hoàn toàn khác nhau

Bài toán của mình đưa ra hoàn toàn dựa vào chủ đề này. Mình chỉ đưa một VD để các bác thấy tác dụng của việc chia ô mà thôi. Thực ra bài toán rất đơn giản, trước khi thực hiện việc tìm giao điểm, các bác hãy chia nhỏ tập hợp chọn theo cách của bác Thai đã viết, sau đó lần lượt đưa từng tập hợp nhỏ này vào tìm giao, sẽ có đc kq nhanh kg ngờ. Nói đến đây thì các bác đã rõ rồi, tuy nhiên mình cũng nhờ bác Ha lồng cái hàm loại bỏ điểm trùng ra vì mình cũng kg rành các hàm vl và vla lắm. Sau đây sd code cua bác Ha và hàm chia ô của bác Thai

(defun c:HATG2 ( / lis i dt p1 p2 Tapchon)
(defun hatg2( ssha)
(foreach x (GIAOSS ssha)
(entmake (list (cons 0 "POINT") (cons 10 x))))
(princ)
)
(defun GIAOSS (ss / a i j objlst lst)
(setq i (sslength ss))
(setq objlst (SS->objlst ss))
(while (> (setq j (1- i) i (1- i)) -1)
(setq a (nth i objlst))
(while (> (setq j (1- j)) -1)
(setq lst (cons (NHOM3 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))))
(LM:Unique (apply 'append lst)))
(defun NHOM3 (lst / a B)
(while lst
(repeat 3
(setq a (cons (car lst) a) lst (cdr lst)))
(setq b (cons (reverse a) B) a nil)) (reverse B))
(defun SS->objlst (ss / i lst)
(repeat (setq i (sslength ss))
(setq lst (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) lst))))
(defun LM:Unique ( l ) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
(setq start (getvar "millisecs"))
(setvar "osmode" 0)
(setq lis (select-c (getvar "extmin") (getvar "extmax") 50 '((0 . "LINE"))))
(setq i 0)
(while (< i (length lis))
(setq dt (nth i lis) p1 (car dt) p2 (cadr dt))
(setq TapChon (ssget "c" p1 p2 '((0 . "line"))))
(hatg2 TapChon)
(setq i (1+ i))
)
(princ (/(- (getvar "millisecs") start)1000.0))
(princ " giay.")
)
Mình còn nhiều thứ ứng dụng PP chia ô này, tuy nhiên cũng phải nhờ các bác giúp một tay.
Cám ơn các bác cho có những CT rất hay và nhớ ủng hộ những giải thuật tuyệt vời cho chủ đề này nhé.
@ bác Ha : về số lượng điểm giao bác đưa ra ở trên có lẽ chưa cx đâu, nó ít hơn nhiều, để mình test bằng PP khác rồi sẽ bàn tiếp. Vì đcx hàm tìm giao của Lisp mình cũng chưa biết cx cỡ nào nhưng do bv của mình thực chất các line đính vào nhau nên rất dễ kiểm tra.

P/s : Đã test bằng PP "nghiệp vụ", trên bv có 878 điểm giao. Nếu sd code cũ test 1 lần kg chia ô thấy có 880 point đc tạo (như vậy số liệu bác Ha đưa ra ở trên là khá cx), nếu sd PP chia ô dù chia 20dt hay 100dt trong 1 ô đều có 876 point đc tạo, như vậy có 2 vị trí thuộc dạng khó hiểu. Sẽ tìm hiểu sau.

@ bác Thai : Kg hiểu sao cái code chia ô của bác nếu cho số đối tượng nhỏ quá (thử 1 hay 2) nó báo lỗi kỳ lạ lắm rồi kg thoát ra đc. Trên bv lớn cho 20 nó cũng bị lỗi. Bác xem lại giúp nhé.

@ Ket : Bạn thông cảm, tuy cái tên tiêu đề mình đặt hơi hẹp, nhưng những vđ mình nếu ra đều liên quan đến việc chia ô. Tuy nhiên, do cảm nhận của mình về vđ này khác các bạn nên các bạn chưa thấy liên quan lắm. Phần mình cảm thấy rất có nhiều ứng dụng hay quanh việc chia ô nhưng vì còn nhiều ý tưởng chưa thành nên các bạn chưa thấy những ứng dụng hay của nó. Tuy nhiên, nó có trở thành một đề tài bổ ích cho anh em Cadviet hay kg còn nhờ vào các bạn.
Hay Ketxu sửa giúp tiêu đề thành "[Yêu cầu] Lisp phân nhỏ tập hợp chọn bằng cách chia ô và các vấn đề liên quan". Cám ơn bạn
  • 0

#77 gia_bach

gia_bach

    biết lệnh adcenter

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

Đã gửi 22 June 2012 - 12:13 PM

Bác Gia Bach cho em hỏi chút. (ssget "_A") có khác gì (ssget "_X") không? em chạy thử nhưng không nhận thấy điều gì khác biệt giữa 2 sel-method này.

Cái này mình luợm đuợc đâu đó trên "mây", chưa bao giờ test thử (vì chưa gặp lỗi).
"A" like "X" but filters frozen out. Selects all objects on thawed layers.

Một vài tùy chọn khác :

SSGET
the underscore (_) is needed with W, F, WP, :S but not with X, A, C, CP, I, L, P, :E ...
(ssget '(2 2))
Create a selection set of the object passing through (2,2):

+. The undocumented "+." mode forces (ssget) to remain in "point" mode, similar to
setting PickAuto to 0.... the "+." puts (ssget) into "point" mode. It helps the ":S"
single-mode act just like (entsel) by avoiding implied selection windows.
A All like "X" but filters frozen out
Selects all objects on thawed layers.
B Box
Selects all objects inside or crossing a rectangle specified by two points. If
the rectangle's points are specified from right to left, Box is equivalent to
Crossing. Otherwise, Box is equivalent to Window.
C Crossing Simular to Window selection
Selects objects within and crossing an area defined by two points. A crossing
selection is displayed as dashed or otherwise highlighted to differentiate it
from window selection. Specifying the corners from right to left creates a
crossing selection. *** (Specifying the corners from left to right creates a window
selection.) (ssget "_C" '(0 0) '(1 1))
Caution: the area must be on the screen for this to work properly - CAB

CP Crossing Polygon
Selects objects within and crossing a polygon defined by specifying points. The
polygon can be any shape but cannot cross or touch itself. AutoCAD draws the
last segment of the polygon so that it is closed at all times. CPolygon is not
affected by the PICKADD system variable.
(ssget "_CP" '((1 1)(3 1)(5 2)(2 4)))
Example with filters (ssget "_CP" '(Point list) '(Filter List))
(setq ss (ssget "_CP" '((0 0)(10 0)(10 10)(0 10)) '((0 . "INSERT") (66 . 1)) ))
Caution: the area must be on the screen for this to work properly - CAB
(vl-cmdf "._zoom" "_E") ; Extents

:D Duplicates OK, else duplicates are ignored
:E Everything in aperture
Everything within the cursor's object selection pickbox.
F Fence
Selects all objects crossing a selection fence. The Fence method is similar to
CPolygon except that AutoCAD does not close the fence, and a fence can cross
itself. Fence is not affected by the PICKADD system variable.
G Groups
Selects all objects within a specified group.
I Implied
Implied selection (objects selected while PICKFIRST is in effect).
L Last
Last visible object added to the database

:L Rejects locked layers
M Multiple
Specifies multiple points without highlighting the objects, thus speeding up
the selection process for complex objects. The Multiple method also selects two
intersecting objects if the intersection point is specified twice.

:N Nested
Call ssnamex for additional information on container blocks and transformation
matrices for any entities selected during the ssget operation. This additional
information is available only for entities selected via graphical selection
methods such as Window, Crossing, and point picks.

Unlike the other object selection methods, :N may return multiple entities with
the same entity name in the selection set. For example, if the user selects a
subentity of a complex entity such as a BlockReference, PolygonMesh, or old
style polyline, ssget looks at the subentity that is selected when determining
if it has already been selected. However, ssget actually adds the main entity
(BlockReference, PolygonMesh, etc.) to the selection set. The result could be
multiple entries with the same entity name in the selection set (each will have
different subentity information for ssnamex to report).
P Previous
Selects the most recent selection set. The Previous selection set is cleared by
operations that delete objects from the drawing. AutoCAD keeps track of whether
each selection set was specified in model space or paper space. The Previous
selection set is ignored if you switch spaces.
:P Rejects Viewport
:R Allows entities in a long transaction to be selected.
:S Force single object selection only
:U Enables subentity selection - 2006+
Cannot be combined with the duplicate (":D") or nested (":N") selection modes.
In this mode, top-level entities are selected by default, but the user can
attempt to select subentities by pressing the CTRL key while making the
selection. This option is supported only with interactive selections, such as
window, crossing, and polygon. It is not supported for all, filtered, or group
selections.
:V Forces subentity selection - 2006+
Treats all interactive, graphic selections performed by the user as subentity
selections. The returned selection set contains subentities only. This option
cannot be combined with the duplicate (":D") or nested (":N") selection modes.
This option is supported only with interactive selections, such as window and
crossing. It is not supported for all, filtered, or group selections.
W Window
Selects all objects completely inside a rectangle defined by two points.
Specifying the corners from left to right creates a window selection.
(Specifying the corners from right to left creates a crossing selection.)
WP Window Polygon
Selects objects completely inside a polygon defined by points. The polygon can
be any shape but cannot cross or touch itself. AutoCAD draws the last segment of
the polygon so that it is closed at all times. WPolygon is not affected by the
PICKADD system variable.
X Extended search (search whole database)
Entire database. If you specify the X selection method and do not provide a
filter-list, ssget selects all entities in the database, including entities on
layers that are off, frozen, and out of the visible screen.

Also at the command prompt "Select objects:" you can enter
Add, Remove, Undo,
:U Enables subentity selection. Cannot be combined with the duplicate (":D") or
nested (":N") selection modes. In this mode, top-level entities are selected by
default, but the user can attempt to select subentities by pressing the CTRL key
while making the selection. This option is supported only with interactive
selections, such as window, crossing, and polygon. It is not supported for all,
filtered, or group selections.
:V Forces subentity selection. Treats all interactive, graphic selections
performed by the user as subentity selections. The returned selection set
contains subentities only. This option cannot be combined with the duplicate
(":D") or nested (":N") selection modes. This option is supported only with
interactive selections, such as window and crossing. It is not supported for
all, filtered, or group selections.
Systen Var
PICKADD controls whether subsequent selections replace the current selection set or add to it.

  • 4

#78 Thaistreetz

Thaistreetz

    biết lệnh adcenter

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

Đã gửi 22 June 2012 - 01:05 PM

hay quá bác Gia Bach ạ. hồi trước em nghiên cứu code express, thấy 1 số hàm select đối tượng của nó khá hay ko hiểu viết kiểu gì được, hóa ra là còn 1 số method của ssget không có trong help như thế này.
@bác TRUNGNGAMY
1. Nếu là lỗi này: error: exceeded maximum number of selection sets
Thông báo này có vẻ đã rất cụ thể rồi, em đoán là số lượng tập chọn đối tượng vượt quá giới hạn cho phép của lisp. Lisp luôn có những giới hạn nhất định cho mỗi kiểu dữ liệu, tại vì chúng ta hiếm khi có nhu cầu chạm tới những giới hạn đó nên không để ý thôi.
2. Nếu là lỗi này: internal stack limit reached (simulated)"\n*** INTERNAL ERROR: VL namespace mismatch\n" " type Y to reset: "
Là lỗi hay gặp khi dùng thuật toán đệ quy và quay lui, do quá trình lặp không tìm thấy điều kiện để thoát. Cũng hơi lạ là 1 số trường hợp không tìm thấy điều kiện thoát lại không có thông báo này để dừng chương trình, cứ thế lặp cho đến khi treo máy. Có lẽ đây là 1 trong số trường hợp đã được cảnh báo nên chương trình nhận diện được và tạm dừng quá trình lặp. em chỉ đoán vậy thôi chứ không chắc lắm.

- Nguyên nhân không thể thoát và không chia được với N nhỏ là do sai số của hàm ssget khi chọn đối tượng mà em đã cảnh báo bác:

Bác chú ý 1 điều quan trọng khi dùng hàm ssget với lựa chọn "c" hoặc "w": đó là việc bản vẽ được zoom to hay nhỏ ảnh hưởng rất lớn đến kết quả chọn đối tượng của hàm ssget.
- Bản vẽ được zoom lớn, độ chính xác của hàm ssget tăng lên nhưng nếu đối tượng vượt khỏi biên hiển thị của màn hình quá xa hàm ssget sẽ không chọn được đối tương đó.
- ngược lại, nếu tập hợp đối tượng bị zoom nhỏ. mật độ đối tượng trên 1 đơn vị diện tích màn hình quá lớn sẽ khiến hàm ssget chạy chậm, độ chính xác giảm và chọn được số đối tượng vược mức thực tế rất nhiều.

1 ví dụ cụ thể để thấy ngay điều này. em thử luôn với bản vẽ bác post ở trang 1.

(defun select-c1 (p1 p2 n filter / ss)
(ts:zoom p1 p2)
(if (setq ss (ssget "c" p1 p2 filter))
(if (< (sslength ss) (abs (setq n (* -1 n))))
(list (list p1 p2))
(if (< n 0)
(append (select-c1 p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2) 0.0) n filter)
(select-c1 p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1) 0.0) n filter))
(append (select-c1 p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1))) 0.0) n filter)
(select-c1 p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1))) 0.0) n filter))))))
(setq *acad-object* (vlax-get-acad-object))
(defun TS:zoom (pt1 pt2) (vlax-invoke *acad-object* 'zoomwindow pt1 pt2))
(defun c:t1 nil
(command "zoom" "e")
(mapcar '(lambda (x) (command "rectang" (car x) (cadr x)))
(select-c1 (getvar "extmin") (getvar "extmax") (getint "max object =") '((0 . "LINE"))))
(princ))
;-----------------------------
(defun select-c (p1 p2 n filter / ss)
(if (setq ss (ssget "c" p1 p2 filter))
(if (< (sslength ss) (abs (setq n (* -1 n))))
(list (list p1 p2))
(if (< n 0)
(append (select-c p1 (list (* 0.5 (+ (car p2) (car p1))) (cadr p2)) n filter)
(select-c p2 (list (* 0.5 (+ (car p2) (car p1))) (cadr p1)) n filter))
(append (select-c p1 (list (car p2) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter)
(select-c p2 (list (car p1) (* 0.5 (+ (cadr p2) (cadr p1)))) n filter))))))
(defun c:t2 nil
(command "zoom" "e")
(mapcar '(lambda (x) (command "rectang" (car x) (cadr x)))
(select-c (getvar "extmin") (getvar "extmax") (getint "max object =") '((0 . "LINE"))))
(princ))
Với cùng phương pháp chia. Trong lệnh t1 em nhét thêm điều kiện zoom bản vẽ đến từng ô rồi mới chọn. việc làm này loại bỏ sai số của lệnh ssget khiến nó có thể chạy được với N nhỏ đến 5. Còn lệnh t2 là nguyên bản thì chỉ có thể chạy được với N>= 20, với lệnh t2, kích thước màn hình của bác cũng ảnh hưởng đến N min. màn hình càng lớn thì có thể chạy được với N càng nhỏ. màn hình của em 21", chạy được với N min = 20.
Cũng với bản vẽ đó, sử dụng lệnh t1 với N<5 chương trình vẫn chạy nhưng rơi vào trường hợp kích thước ô chọn bị chia nhỏ quá giới hạn đơn vị của cad, hình như là 1E-13 thì phải. Nhỏ hơn giới hạn này cad không tính toán được và coi là 1 điểm.
  • 1

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


#79 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 22 June 2012 - 01:45 PM

@Thai: Bổ sung thêm 1 ý nhỏ: con số giới hạn số lượng tập hợp chọn là 128 cho cad đời cũ. Không biết cad đời mới có tăng thêm không.

P/s : Đã test bằng PP "nghiệp vụ", trên bv có 878 điểm giao. Nếu sd code cũ test 1 lần kg chia ô thấy có 880 point đc tạo (như vậy số liệu bác Ha đưa ra ở trên là khá cx), nếu sd PP chia ô dù chia 20dt hay 100dt trong 1 ô đều có 876 point đc tạo, như vậy có 2 vị trí thuộc dạng khó hiểu. Sẽ tìm hiểu sau.

Về lý do sai sót số điểm giao thì như bác Thai đã phân tích ở trên: khi khung chọn đủ nhỏ thì hàm ssget nó chọn nhầm cả những đối tượng nằm lân cận bên ngoài khung. Tôi đã từng gặp rồi. => pp chia ô nhỏ để dùng ssget rất khó đạt chính xác.
Số điểm giao đã kiểm tra lại là 879. Trong lisp của tôi thì nó là 880, tức dư 1 điểm trùng (và đã tìm ra nó). Lý do là hàm member hay LM:Unique đều xét theo tính chất của hàm =, chứ không phải xét theo hàm equal.
VD: ta vẽ 1 circle, sau đó copy lên chính nó, bây giờ dùng 2 hàm sau để kiểm tra:
1). (equal p1 p2 0.0001) thì luôn trả về T
2). (= (distance p1 p2) 0) thì đôi lúc trả về nil. Đây là điều "oái oăm" nhất.
Cuối cùng, nếu muốn kết quả lúc nào cũng đúng thì chắc không thể dùng member hoặc LM:Unique để kiểm tra list points được mà phải thay bởi một hàm kiểu equal thôi.
  • 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.


#80 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 22 June 2012 - 05:32 PM

@Thai: Bổ sung thêm 1 ý nhỏ: con số giới hạn số lượng tập hợp chọn là 128 cho cad đời cũ. Không biết cad đời mới có tăng thêm không.

Về lý do sai sót số điểm giao thì như bác Thai đã phân tích ở trên: khi khung chọn đủ nhỏ thì hàm ssget nó chọn nhầm cả những đối tượng nằm lân cận bên ngoài khung. Tôi đã từng gặp rồi. => pp chia ô nhỏ để dùng ssget rất khó đạt chính xác.
Số điểm giao đã kiểm tra lại là 879. Trong lisp của tôi thì nó là 880, tức dư 1 điểm trùng (và đã tìm ra nó). Lý do là hàm member hay LM:Unique đều xét theo tính chất của hàm =, chứ không phải xét theo hàm equal.
VD: ta vẽ 1 circle, sau đó copy lên chính nó, bây giờ dùng 2 hàm sau để kiểm tra:
1). (equal p1 p2 0.0001) thì luôn trả về T
2). (= (distance p1 p2) 0) thì đôi lúc trả về nil. Đây là điều "oái oăm" nhất.
Cuối cùng, nếu muốn kết quả lúc nào cũng đúng thì chắc không thể dùng member hoặc LM:Unique để kiểm tra list points được mà phải thay bởi một hàm kiểu equal thôi.

Sai số này kg phải do PP chia ô. Khi mình cho số đối tượng trong 1 ô khá lớn (khoảng 2000). xem như nó chọn hết 1 lần, vẫn xảy ra sai số trên, tức nếu kg dùng PP chia ố, chọn all thì có 880 điểm, nếu chia 1 ô (cho số đối tượng lớn hơn tổng số có trên bản vẽ) hay nhiều ô (khoảng 20 dt) vẫn ra 876 điểm. Nguyên nhân do chính bản thân thằng cad, nó kg trước sau như một. TH này mình gặp cũng nhiều. Cũnh phải chấp nhận thôi. Tuy nhiên, lúc rãnh mình sẽ tìm nguyên nhân thật cx để đề phòng. Cám ơn bạn
  • 0