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

[TRUNGNGAMY 91]

;--------------------------------------------------------------- CAC HAM CHINH
;----- Ham luu bien toan cuc khi chia o.
(defun C:HA1()
(command "zoom" "e")
(princ "\nChuong trinh dang chay. Xin vui long doi...\n")
(setq entlst (mapcar '(lambda (x) (MakeRectang (car x) (cadr x))) (select-c (getvar "extmin") (getvar "extmax") 500 '((0 . "LINE"))))))
(defun select-c (p1 p2 n filter)
(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))))))
;----- Ham kiem tra HCN
(defun C:HA2()
(setq p (getpoint "\nPick point: "))
(setq lst1 '())
(foreach ent entlst
 (if (not (HA:InOut ent p))
  (setq lst1 (cons ent lst1))))
lst1)
;--------------------------------------------------------------- CAC HAM PHU
(defun MakeRectang (p1 p2)
(entmakex (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 4) (cons 70 1)
  (cons 10 p1) (cons 10 (list (car p1) (cadr p2))) (cons 10 p2) (cons 10 (list (car p2) (cadr p1))))))
(defun HA:InOut (ent p / lst tt z n)
(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
  		tt ((lambda (n) (mapcar '/ (apply 'mapcar (cons '+ lst)) (list n n n))) (float (length lst)))
  		lst (vl-sort lst '(lambda (a B) (> (angle tt a) (angle tt B))))
  		lst (append lst (list (car lst))))
(setq z 0)
(repeat (1- (length lst))
 (if (< (sin (- (angle p (nth z lst)) (angle p (nth (1+ z) lst)))) -1e-14) (setq n T))
 (setq z (1+ z)))
n)

Cám ơn bạn. Sau khi xem kỹ code của bạn mình đã tách ra đc rồi. Bạn cho mình hỏi, có thể kg vẽ các HCN ra màn hình đc kg, có nghĩa là căn cứ vào hàm của bác Thai, sau khi có danh sach tọa độ đỉnh của HCN thì dùng luôn cho việc tìm kiểm chứ kg cần vẽ ra HCN (kể cả việc vẽ rồi xóa cũng kg nên). Ý mình muốn trả về 2 đỉnh của HCN có đc kg (thay vì trả về ename của nó, việc kg vẽ HCN thì hay hơn).

[Doan Van Ha 3.191]

Những yêu cầu của bạn đều làm được. Hôm nay tôi bận đi công tác sớm, nếu đến tối nay mà chưa có ai giúp bạn thì tôi sẽ giúp.

[Doan Van Ha 3.191]

Bạn test xem đúng yêu cầu không nhé.

(defun C:HA1()
(command "zoom" "e")
(princ "\nChuong trinh dang chay. Xin vui long doi...\n")
(setq hcnlst (mapcar '(lambda (x) (list (car x) (cadr x))) (select-c (getvar "extmin") (getvar "extmax") 500 '((0 . "LINE"))))))
(defun select-c (p1 p2 n filter)
(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:HA2()
(setq p (getpoint "\nPick point: "))
(setq lst1 '())
(foreach hcn hcnlst
 (if (not (HA:InOut hcn p))
  (setq lst1 (cons hcn lst1))))
lst1)
(defun HA:InOut (hcn p / lst tt z n)
(setq lst (list
            	(list (car (cadr hcn)) (cadr (cadr hcn)))
            	(car hcn)
            	(list (car (car hcn)) (cadr (cadr hcn)))
            	(cadr hcn)))
(setq z 0)
(repeat (1- (length lst))
 (if (< (sin (- (angle p (nth z lst)) (angle p (nth (1+ z) lst)))) -1e-14) (setq n T))
 (setq z (1+ z)))
n)

[TRUNGNGAMY 91]

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.

(defun c:ChenGiao ( / lis)
 (setq TapChon (ssget)
 ;TenBlock "ddhsb1"
 lis nil
 )
;(if (tblsearch "block" TenBlock)
;(progn
 (setq SoDoiTuong (sslength TapChon) cs1 0)
 (repeat SoDoiTuong
(setq DoiTuong1 (ssname TapChon cs1) cs2 (+ cs1 1))
(repeat (- SoDoiTuong cs1 1)
 	(setq DoiTuong2 (ssname TapChon cs2) TapGiaoDiem (GiaoDT DoiTuong1 DoiTuong2) cs2 (+ cs2 1))
 	(setq lis (append lis tapgiaodiem))
 	(print TapGiaoDiem)
 	(foreach Diem TapGiaoDiem (command "_.point" diem))
 	;(foreach Diem TapGiaoDiem (entmake (list (cons 0 "insert") (cons 2 TenBlock) (cons 10 Diem))))
)
(setq cs1 (+ cs1 1))
 )
;)
;(princ "Khong co ten block")
;)
 lis
)

(defun GiaoDT (ent1 ent2)
 (setq ob1 (vlax-ename->vla-object ent1) ob2 (vlax-ename->vla-object ent2))
 (setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
 )
 (if g (progn
(setq kq nil sd (fix (/ (length g) 3)))
(repeat sd
 	(setq kq (append kq (list (list (car g) (cadr g) (caddr g)))) g (cdddr g))
)
kq
 ) nil)
)
(vl-load-com)

Đây là bản vẽ

http://www.cadviet.c...170_ttline2.dwg

[Thaistreetz 539]

- Bác bỏ hàm (princ tapgiaodiem) đi, hoặc có thể viết lại thành thế này (if tapgiaodiem (princ tapgiaodiem)). Để như hiện tại thì mỗi vòng lặp tìm giao điểm nó lại thực hiện1 lần princ, hàm này cực chậm nếu in nội dung ra màn hình.

- Thay hàm (command "point"...) bằng 1 hàm entmake hoặc 1 hàm vla để tạo point.

2 việc làm này có thể tăng tốc độ lên đáng kể.

[TRUNGNGAMY 91]

- Bác bỏ hàm (princ tapgiaodiem) đi, hoặc có thể viết lại thành thế này (if tapgiaodiem (princ tapgiaodiem)). Để như hiện tại thì mỗi vòng lặp tìm giao điểm nó lại thực hiện1 lần princ, hàm này cực chậm nếu in nội dung ra màn hình.

- Thay hàm (command "point"...) bằng 1 hàm entmake hoặc 1 hàm vla để tạo point.

2 việc làm này có thể tăng tốc độ lên đáng kể.

Tham khảo ý của bạn, mình đã chỉnh một ít. Code đã chỉnh lại ở đây :

(vl-load-com)
(defun c:ChenGiao ( / lis)
 (setq TapChon (ssget) lis nil)
 (setq SoDoiTuong (sslength TapChon) cs1 0)
 (repeat SoDoiTuong
(setq DoiTuong1 (ssname TapChon cs1) cs2 (+ cs1 1))
(repeat (- SoDoiTuong cs1 1)
 	(setq DoiTuong2 (ssname TapChon cs2) TapGiaoDiem (GiaoDT DoiTuong1 DoiTuong2) cs2 (+ cs2 1))
 	(foreach Diem TapGiaoDiem (if (null (member diem lis)) (progn
   	(setq lis (append lis (list diem)))
   	(entmake (list (cons 0 "point") (cons 10 diem)))
 	)))
)
(setq cs1 (+ cs1 1))
 )
)
(defun GiaoDT (ent1 ent2)
 (setq ob1 (vlax-ename->vla-object ent1) ob2 (vlax-ename->vla-object ent2))
 (setq g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)))
 (if (/= (vlax-safearray-get-u-bound g 1) -1)
(setq g (vlax-safearray->list g))
(setq g nil)
 )
 (if g (progn
(setq kq nil sd (fix (/ (length g) 3)))
(repeat sd
 	(setq kq (append kq (list (list (car g) (cadr g) (caddr g)))) g (cdddr g))
)
kq
 ) nil)
)

Tốc độ bây giờ còn 30'', nhưng mình muốn các bạn viết thử sao cho tốc độ còn khoảng dưới 3'' (tức =10% tùy máy). Đó là với bản vẽ nhỏ, với bản vẽ lớn như mình up lên ở trang đầu, mình chạy thử trong 5h chỉ đc 20%, có nghĩa nếu chạy xong phải mất từ 20-25h, nhưng các bạn thử viết cho nó chạy trong khoảng dưới 5' (tức giảm khoảng 240-300 lần) thôi xem sao.

[ketxu 2.984]

Tốc độ bây giờ còn 30'', nhưng mình muốn các bạn viết thử sao cho tốc độ còn khoảng dưới 3'' (tức =10% tùy máy). Đó là với bản vẽ nhỏ, với bản vẽ lớn như mình up lên ở trang đầu, mình chạy thử trong 5h chỉ đc 20%, có nghĩa nếu chạy xong phải mất từ 20-25h, nhưng các bạn thử viết cho nó chạy trong khoảng dưới 5' (tức giảm khoảng 240-300 lần) thôi xem sao.

Bài tập cô cho hả bạn ơi :)

[Thaistreetz 539]

Lisp này chậm khủng khiếp như vậy là do phương pháp tìm giao không hợp lý. hoặc bác TRUNGNGAMY áp dụng lisp này cho nhu cầu trên là không hợp lý.

- tác giả cho lặp n lần với n là số đối tượng của tập hợp. mỗi lần lặp lấy ra 1 đối tượng.

- với mỗi lần lặp lại duyệt lại toàn bộ số đối tượng của tập hợp xem có anh nào giao với đối tượng được chọn của bước lặp trước không. <= Chậm chính là ở đây.

Với cách làm như thế này thì số lần phải duyệt đối tương sẽ bằng bình phương của số đối tượng. Vì vậy không thể dùng với số lượng đối tượng lớn.

1 vd để thấy sự chênh lệch khủng khiếp khi số đối tượng tăng lên: chênh lệch số lần phải lặp giữa 200 đối tượng và 100 đối tượng là: 200x200 - 100x100 = 30000 lần lặp.

 

mình đưa giải pháp khắc phục, các bước làm như sau:

- cho lặp tập chọn n lần với n là số đối tượng của tập chọn. mỗi lần lặp lấy ra 1 đối tượng.

- với mỗi lần lặp, lấy tọa độ BB của đối tượng rồi (ssget "c") trong khoảng BB đó.

- lặp danh sách đối tượng vừa chọn rồi tìm giao của từng đối tượng với đối tượng lặp ở bước 1.

Với tính chất bản vẽ như của bác TRUNGNGAMY thì có thể khẳng định sẽ giảm khoảng > 90% số lần phải lặp so với lisp trên. bản vẽ càng nhiều đối tượng thì tỷ lệ giảm càng tăng, thậm chí có thể giảm tới 99,99% nếu số lượng đối tượng đủ lớn.

Với số lượng đối tượng nhỏ, phương pháp này sẽ không hiệu quả hơn phương pháp trước, thậm chí cũng có thể chậm hơn. Minh từng viết 1 lisp tìm kiếm các text cao độ trên bình đồ và xóa các text đè lên nhau chỉ để lại 1 text (mục đích cho bản vẽ thông thoáng dễ đọc), thuật toán cũng tương tự thế này.

[TRUNGNGAMY 91]

Bài tập cô cho hả bạn ơi :)

Ket lúc này đâm ra hay nghi ngờ nhỉ. Xem như là đố vui đi. Nếu sau 1 ngày mà các bạn chưa đưa lên ra thì mình sẽ có đáp án.

Mình có một số ý tưởng hay (đối với riêng mình) nhưng kg thể viết hết đc, có những thứ phải có sự trợ giúp của các bạn sau đó mình mới tạo ra đc những ứng dụng hữu ích. Mình chỉ tím cách kích thích các bạn viết những Lisp hay, sưu tầm, vận dụng và chỉ ra cho các bạn thấy những ứng dụng hữu ích của nó để các bạn cảm thấy thích thú với những sáng tạo xuất thần của mình (có thể nó chỉ có ích trong lĩnh vực của mình).

Do mình viết Lisp và Arx từ rất lâu nên những gì cần thiết trong công việc mình đã viết gần như là đầy đủ, tất nhiên có cái chưa hay. Những gì mình đưa lên nhờ các bạn mình cần những ý tưởng mang tính đột phá để thay đổi cái cũ mình đang có (hoài bão thôi chứ chưa chắc có thời gian thực hiện). Nhưng chung quy có lẽ giải trí là chính

 

P/S : Xin giải thích câu : "các bạn cảm thấy thích thú với những sáng tạo xuất thần của mình " : mình ở đây chính là các bạn

[Doan Van Ha 3.191]

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 5".

(vl-load-com)
(defun C:HA ( / ss lst i j objlst obj pt start)
(setq ss (ssget '((0 . "LINE"))))
(setq start (getvar "millisecs"))
(setq i (sslength ss))
(setq objlst (SS->objlst ss))
(while (> (setq j (1- i) i (1- i)) -1)
 (setq obj (nth i objlst))
 (while (> (setq j (1- j)) -1)
  (if (setq pt (vlax-Invoke obj "IntersectWith" (nth j objlst) 0))
(if (not (member pt lst))
(progn
 	(setq lst (cons pt lst))
 	(entmake (list (cons 0 "POINT") (cons 10 pt))))))))
(princ (strcat (rtos (/ (- (getvar "millisecs") start)1000.0) 2) " giay."))
(princ))
(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))))

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

[TRUNGNGAMY 91]

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.

[thiep 365]

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"

[TRUNGNGAMY 91]

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

[thiep 365]

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à

[Thaistreetz 539]

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.

[ketxu 2.984]

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

[Doan Van Ha 3.191]

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

[gia_bach 1.549]

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

[Doan Van Ha 3.191]

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.

[TRUNGNGAMY 91]

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

[TRUNGNGAMY 91]

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

[TRUNGNGAMY 91]

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

[Doan Van Ha 3.191]

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.

[Thaistreetz 539]

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.

[ketxu 2.984]

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