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

[TRUNGNGAMY 91]

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

[gia_bach 1.549]

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.

[Thaistreetz 539]

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.

[Doan Van Ha 3.191]

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

[TRUNGNGAMY 91]

@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

[thiep 365]

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

Hi NgaMy, với bản vẽ giải thửa của bạn, thiep lợi dụng ở chỗ là các LINE thường chỉ giao nhau ở điểm startpoint hay endpoint, còn nếu cùng lắm là chúng giao nhau hay chưa giao nhau với 1 khoảng cách từ điểm giao đến startpoint hay endpoint ví dụ = 0.002m. Như vậy không cần phải dùng phương thức "IntersectWith" chi cho tốn thời gian, mà chỉ cần tìm điểm startpoint hay endpoint nào gần nhau với sai số max thì loại khỏi cuộc chơi.

[thiep 365]

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

Lisp của thiep đã chỉnh sửa nhờ sự góp ý của bạn và Thaistreetz, chạy không hơn 0,5" trên máy core ™2 Duo 2.8GHz, 2G Ram

[/codebox] (defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len n)

(setq TapChon (ssget '((0 . "LINE")))

entlst (ACET-SS-TO-LIST TapChon)

lst nil

)

(setq tg (getvar "millisecs"))

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(command "undo" "be")

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

(setq len (length lst)

r 0.5

n 0)

(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 "CP" lstF '((0 . "*LINE"))))

(if (and ss (> (sslength ss) 1))

(progn

(entmake (list (cons 0 "POINT") (cons 10 Diem)))

(setq n (1+ n))

)

)

)

(alert (strcat " Mat thoi gian la: "

(rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3)

" giay de tao duoc " (itoa n) " points")

)

(command "undo" "en")

(princ n)

(princ)

) [/codebox]

[TRUNGNGAMY 91]

Lisp của thiep đã chỉnh sửa nhờ sự góp ý của bạn và Thaistreetz, chạy không hơn 0,5" trên máy core ™2 Duo 2.8GHz, 2G Ram

[/codebox] (defun c:cg (/ TapChon entlst lst tg Now Pstart Pend len n)

(setq TapChon (ssget '((0 . "LINE")))

entlst (ACET-SS-TO-LIST TapChon)

lst nil

)

(setq tg (getvar "millisecs"))

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(command "undo" "be")

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

(setq len (length lst)

r 0.5

n 0)

(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 "CP" lstF '((0 . "*LINE"))))

(if (and ss (> (sslength ss) 1))

(progn

(entmake (list (cons 0 "POINT") (cons 10 Diem)))

(setq n (1+ n))

)

)

)

(alert (strcat " Mat thoi gian la: "

(rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3)

" giay de tao duoc " (itoa n) " points")

)

(command "undo" "en")

(princ n)

(princ)

) [/codebox]

Cám ơn Thiep. Chạy trên máy của mình, kết quả như sau :

- của Thiep : " Mat thoi gian la: 0.672 giay de tao duoc 879 points"

- của Ha kết hợp PP chia ô : " Mat thoi gian la: 0.578 giay de tao duoc 880 points"

- cua Ha nguyên gốc : " Mat thoi gian la: 13.906 giay de tao duoc 880 points"

- của một bạn kết hợp PP chia ô : " Mat thoi gian la: 1.203 giay de tao duoc 876 points"

Nói chung của Thiep và của bác Ha có kết hợp PP chia ô chạy nhanh nhất và số lượng điểm như nhau. Những PP khác chậm hơn nhưng có số lượng điểm hơi khác. Có thể do hàm tìm giao của Cad cũng kg ổn định.

Đây là code của bác Ha kết hợp PP chia ô của bác Thái.

(defun c:HATG2 ( / lis i dt p1 p2 Tapchon)
(defun GIAOSS-2 (ss / a i j objlst lst)
 (setq i (sslength ss))
 (setq objlst (SS->objlst-2 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-2 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))
)
 )
 lst
;  (print (LM:Unique-2 (apply 'append lst)))
)
(defun NHOM3-2 (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-2 (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-2 ( l )
 (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
 (setq tg (getvar "millisecs"))
 (setvar "osmode" 0)
 (setq lis (select-c (getvar "extmin") (getvar "extmax") 20 '((0 . "LINE"))))
 (setq i 0 liskt nil)
 (while (< i (length lis))
(setq dt (nth i lis) p1 (car dt) p2 (cadr dt))
(setq TapChon (ssget "c" p1 p2 '((0 . "line"))))
(setq liskt (append liskt (Giaoss-2 TapChon)))
(setq i (1+ i))
 )
 (setq liskt (LM:Unique-2 (apply 'append liskt)))
 (foreach x liskt (entmake (list (cons 0 "POINT") (cons 10 x))))
 (print (strcat " Mat thoi gian la: "
(rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3)
" giay de tao duoc " (itoa (length liskt)) " points")
 )
)

[ketxu 2.984]

PP tìm giao của CAD ổn định - không phụ thuộc linetype, góc view. SSget thì ngược lại

[thiep 365]

Cám ơn Thiep. Chạy trên máy của mình, kết quả như sau :

- của Thiep : " Mat thoi gian la: 0.672 giay de tao duoc 879 points"

- của Ha kết hợp PP chia ô : " Mat thoi gian la: 0.578 giay de tao duoc 880 points"

- cua Ha nguyên gốc : " Mat thoi gian la: 13.906 giay de tao duoc 880 points"

- của một bạn kết hợp PP chia ô : " Mat thoi gian la: 1.203 giay de tao duoc 876 points"

Nói chung của Thiep và của bác Ha có kết hợp PP chia ô chạy nhanh nhất và số lượng điểm như nhau. Những PP khác chậm hơn nhưng có số lượng điểm hơi khác. Có thể do hàm tìm giao của Cad cũng kg ổn định.

Đây là code của bác Ha kết hợp PP chia ô của bác Thái.

(defun c:HATG2 ( / lis i dt p1 p2 Tapchon)
(defun GIAOSS-2 (ss / a i j objlst lst)
 (setq i (sslength ss))
 (setq objlst (SS->objlst-2 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-2 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))
)
 )
 lst
;  (print (LM:Unique-2 (apply 'append lst)))
)
(defun NHOM3-2 (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-2 (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-2 ( l )
 (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)
 (setq tg (getvar "millisecs"))
 (setvar "osmode" 0)
 (setq lis (select-c (getvar "extmin") (getvar "extmax") 20 '((0 . "LINE"))))
 (setq i 0 liskt nil)
 (while (< i (length lis))
(setq dt (nth i lis) p1 (car dt) p2 (cadr dt))
(setq TapChon (ssget "c" p1 p2 '((0 . "line"))))
(setq liskt (append liskt (Giaoss-2 TapChon)))
(setq i (1+ i))
 )
 (setq liskt (LM:Unique-2 (apply 'append liskt)))
 (foreach x liskt (entmake (list (cons 0 "POINT") (cons 10 x))))
 (print (strcat " Mat thoi gian la: "
(rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3)
" giay de tao duoc " (itoa (length liskt)) " points")
 )
)

Hi NgaMy, Lisp của bạn còn thiếu 2 hàm con select-c1 và LM:UNIQUE, và cho kết quả là 880 points là chưa chính xác lắm. Chính xác là 879 points. ban đầu lisp của Thiep cho kết quả 881 points, Thiep rất mất thời gian điểm tìm ra nguyên nhân này và phải "mua" thời gian chạy lisp thêm 0,07" nữa đó!

[TRUNGNGAMY 91]

Hi NgaMy, Lisp của bạn còn thiếu 2 hàm con select-c1 và LM:UNIQUE, và cho kết quả là 880 points là chưa chính xác lắm. Chính xác là 879 points. ban đầu lisp của Thiep cho kết quả 881 points, Thiep rất mất thời gian điểm tìm ra nguyên nhân này và phải "mua" thời gian chạy lisp thêm 0,07" nữa đó!

Mình cũng dự định tìm thử xem tại sao lại có sự khác nhau đó. Nếu Thiep đã tìm ra rồi thì nói cho mình biết lý do và chỉ ra vị trí của nó để tránh cho những lần khác.

Sau đây là code của hàm select-c (kg phải select-c1) của bác Thai:

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

Còn hàm LM:UNIQUE bạn sửa thành LM:UNIQUE-2 luôn. Hàm này do bác Ha viết.

 

Mình thấy PP của bạn cũng tương đồng với PP chia ô nên mới có kq nhanh như vậy. Có thể mình sẽ test thêm trên một số loại file và dữ liệu khác để biết cx về 2 PP này. Tuy nhiên, PP chia ô thì khó bỏ sót đối tượng (vì tất cà các hình vuông phủ kín đường bao bv), còn PP của bạn khi gặp đối tượng là một cung tròn, một đoạn cong thì kg rõ có cx kg

[Thaistreetz 539]

Bác sửa luôn phần khai báo biến và tham số của hàm trên cho em nhé. (p1 p2 n filter) thành (p1 p2 n filter / ss)

Em quên chưa định nghĩa biến ss là biến cục bộ.

[TRUNGNGAMY 91]

Bác sửa luôn phần khai báo biến và tham số của hàm trên cho em nhé. (p1 p2 n filter) thành (p1 p2 n filter / ss)

Em quên chưa định nghĩa biến ss là biến cục bộ.

Cám ơn bác Thai.

@Thiep : Hàm của Thiep như mình đã nói ở trước, nó kg chạy khi có đối tượng kg gối đỉnh vào nhau. Mình đã thử khi vẽ 2 line bất kỳ thì nó kg xét hai line này. Xem sơ qua cách viết của Thiep có lẽ trên bv nếu có line dài nhiều sẽ tốn thời gian hơn PP chia ô vì lúc đó nó sẽ chọn mỗi lần nhiều đối tượng hơn. PP chia ô nói chung sẽ ổn định nhất vì mình đã khống chế số đối tượng cho mỗi lần chọn. Tuy nhiên, vđ nằm ở giải thuật của bác Thai, làm sao tránh đc vòng lặp bị treo vì khi định số đối tượng trong 1 ô, nếu định nhiều quá làm chậm quá trình, định ít quá gây lỗi như đã nêu.

[TRUNGNGAMY 91]

Cám ơn Thiep. Chạy trên máy của mình, kết quả như sau :

- của Thiep : " Mat thoi gian la: 0.672 giay de tao duoc 879 points"

- của Ha kết hợp PP chia ô : " Mat thoi gian la: 0.578 giay de tao duoc 880 points"

- cua Ha nguyên gốc : " Mat thoi gian la: 13.906 giay de tao duoc 880 points"

- của một bạn kết hợp PP chia ô : " Mat thoi gian la: 1.203 giay de tao duoc 876 points"

Nói chung của Thiep và của bác Ha có kết hợp PP chia ô chạy nhanh nhất và số lượng điểm như nhau. Những PP khác chậm hơn nhưng có số lượng điểm hơi khác. Có thể do hàm tìm giao của Cad cũng kg ổn định.

Đây là code của bác Ha kết hợp PP chia ô của bác Thái.

(defun c:HATG2 ( / lis i dt p1 p2 Tapchon)
(defun GIAOSS-2 (ss / a i j objlst lst)
 (setq i (sslength ss))
 (setq objlst (SS->objlst-2 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-2 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))
)
 )
 lst
;  (print (LM:Unique-2 (apply 'append lst)))
)
(defun NHOM3-2 (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-2 (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-2 ( l )
 (if l (cons (car l) (LM:Unique-2 (vl-remove (car l) (cdr l)))))
)
 (setq tg (getvar "millisecs"))
 (setvar "osmode" 0)
 (setq lis (select-c (getvar "extmin") (getvar "extmax") 20 '((0 . "LINE"))))
 (setq i 0 liskt nil)
 (while (< i (length lis))
(setq dt (nth i lis) p1 (car dt) p2 (cadr dt))
(setq TapChon (ssget "c" p1 p2 '((0 . "line"))))
(setq liskt (append liskt (Giaoss-2 TapChon)))
(setq i (1+ i))
 )
 (setq liskt (LM:Unique-2 (apply 'append liskt)))
 (foreach x liskt (entmake (list (cons 0 "POINT") (cons 10 x))))
 (print (strcat " Mat thoi gian la: "
(rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3)
" giay de tao duoc " (itoa (length liskt)) " points")
 )
)

- Phiền bác Ha xem qua và lồng cái hàm kiểm tra điểm trùng sao cho nó hợp lý khi kết hợp với PP chia ô giúp. Trên bv lớn 42200dt nếu chạy code của bạn kết hợp PP chia ô chỉ mất 26'' nhưng khi mình cố tình thêm code kiểm tra điểm trùng thì nó tăng lên 350''. Có thể do mình chưa hiểu hết code của bác nên cách kết hợp chưa hay, một nữa là khi trên bv lớn thì list nó lớn nên thời gian kiểm tra tăng lên đáng kể.

- PP chia ô kết hợp code của bác hiện là chạy nhanh nhất rồi. Mình test code của Thiep trên bv lớn cũng mất 418''.

Cám ơn bác

[Doan Van Ha 3.191]

Bạn gởi bản vẽ 42200 đt lên để dễ kiểm tra. Chiều tôi sẽ cố gắng xem sao. Giờ ngáp quá vì thằng Euro rồi. :lol:

[TRUNGNGAMY 91]

Bạn gởi bản vẽ 42200 đt lên để dễ kiểm tra. Chiều tôi sẽ cố gắng xem sao. Giờ ngáp quá vì thằng Euro rồi. :lol:

Nó ở #6 cùng chủ đề

[Doan Van Ha 3.191]

Tiếc là dù tôi đã thêm (vl-load-com) + chép hàm select đầy đủ, nhưng khi chạy nó báo lối như ở #78 nên không thể làm gì được với yêu cầu của bạn.

[thiep 365]

Cám ơn bác Thai.

@Thiep : Hàm của Thiep như mình đã nói ở trước, nó kg chạy khi có đối tượng kg gối đỉnh vào nhau. Mình đã thử khi vẽ 2 line bất kỳ thì nó kg xét hai line này. Xem sơ qua cách viết của Thiep có lẽ trên bv nếu có line dài nhiều sẽ tốn thời gian hơn PP chia ô vì lúc đó nó sẽ chọn mỗi lần nhiều đối tượng hơn. PP chia ô nói chung sẽ ổn định nhất vì mình đã khống chế số đối tượng cho mỗi lần chọn. Tuy nhiên, vđ nằm ở giải thuật của bác Thai, làm sao tránh đc vòng lặp bị treo vì khi định số đối tượng trong 1 ô, nếu định nhiều quá làm chậm quá trình, định ít quá gây lỗi như đã nêu.

Hi Ngamy, thiep đã chạy thử lisp của bạn có bị lỗi như sau:

* không tạo điểm tại 2 vị trí: (588359.873,1182011.308) và (588557.769,1182018.526)

: lỗi này do hàm intersectWith nó hiểu rằng 2 đoạn thẳng gần song song nhau sẽ gặp nhau ở vô cùng.

* Một số điểm gần như trùng nhau:

- tại vị trí (588434.466,1181927.813) có 2 điểm hầu như gần trùng nhau.

- tại vị trí (588370.820,1181943.243) có 3 điểm hầu như gần trùng nhau.

- tại vị trí (588343.175,1181971.641) có 5 điểm hầu như gần trùng nhau.

: lỗi này cũng do intersectWith tạo ra khi nó hiểu rằng có 3, hay 4 đoạn thẳng hội tụ gần nhau tại 1 điểm mà không gặp nhau tại 1 điểm, thì nó tìm ra nhiều điểm giao như Thiệp đã đề cập bài trước.

Còn Lisp của thiep không chạy khi có đối tượng không gối đỉnh vào nhau, là vì thiep không dùng phương thức intersectWith mà chỉ dùng thuật toán so sánh các điểm gần nhau : có 2 hay nhiều điểm nằm gần nhau trong phạm vi sai số fuzz thì loại bỏ hết chỉ còn 1 điểm để tạo point, hàm (ACET-LIST-REMOVE-DUPLICATES ). Bvẽ của bạn, thiep thử cho sai số fuzz = 0.002, lisp tạo ra 879 points. Sau khi phát hiện lisp của bạn có lỗi, quay lại bản vẽ, thiep phát hiện có 1 cạnh giải thửa có chiều dài 0.0375 (đo sai số chính xác thật!) và thiep thử cho sai số 0.03 thì lisp tạo ra chỉ có 873 points!!! Con số này có lẽ đúng nhất và lisp cũng chỉ chạy có 0,515"

[TRUNGNGAMY 91]

@ Thiep : Thực ra mình cần thuật toán cắt nhau, tức 2 đt cắt nhau chứ kg gối đầu vào nhau. Nếu 2 đt gối đầu vào nhau thì dùng thuật toán khác sẽ nhanh hơn. VD :

(defun c:tentpoint( / ss i n name p10 p11 lis1 lis2)
 (defun diem( name n)
(cdr (assoc n (entget name)))
 )
 (setq tg (getvar "millisecs"))
 (setq ss (ssget "x" '((0 . "line"))))
 (if ss (progn
(setq i 0 L (sslength ss) lis nil n 0)
(while (< i L)
 	(setq name (ssname ss i))
 	(setq p10 (diem name 10) p11 (diem name 11))
 	(if (null (assoc p10 lis1)) (setq lis1 (append lis1 (list (list p10)))) (if (null (assoc p10 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
 	           	(entmake (list (cons 0 "POINT") (cons 10 p10)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list p10))))))
 	)
 	(if (null (assoc p11 lis1)) (setq lis1 (append lis1 (list (list p11)))) (if (null (assoc p11 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
 	           	(entmake (list (cons 0 "POINT") (cons 10 p11)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list p11))))))
 	)
 	(setq i (1+ i))
)
 ))
 (print (strcat " Mat thoi gian la: " (rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3) " giay de tao duoc " (itoa n) " points"))
)

Sau khi chạy thì : " Mat thoi gian la: 0.328 giay de tao duoc 871 points"

@ bác Ha : bác thay dòng 20 ở dòng này thành 50

(setq lis (select-c (getvar "extmin") (getvar "extmax") 20 '((0 . "LINE"))))

tức 1 ô có 20 đt thành 1 ô có 50 đt

[thiep 365]

@ Thiep : Thực ra mình cần thuật toán cắt nhau, tức 2 đt cắt nhau chứ kg gối đầu vào nhau. Nếu 2 đt gối đầu vào nhau thì dùng thuật toán khác sẽ nhanh hơn. VD :

(defun c:tentpoint( / ss i n name p10 p11 lis1 lis2)
 (defun diem( name n)
(cdr (assoc n (entget name)))
 )
 (setq tg (getvar "millisecs"))
 (setq ss (ssget "x" '((0 . "line"))))
 (if ss (progn
(setq i 0 L (sslength ss) lis nil n 0)
(while (< i L)
 	(setq name (ssname ss i))
 	(setq p10 (diem name 10) p11 (diem name 11))
 	(if (null (assoc p10 lis1)) (setq lis1 (append lis1 (list (list p10)))) (if (null (assoc p10 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
                	(entmake (list (cons 0 "POINT") (cons 10 p10)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list p10))))))
 	)
 	(if (null (assoc p11 lis1)) (setq lis1 (append lis1 (list (list p11)))) (if (null (assoc p11 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
                	(entmake (list (cons 0 "POINT") (cons 10 p11)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list p11))))))
 	)
 	(setq i (1+ i))
)
 ))
 (print (strcat " Mat thoi gian la: " (rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3) " giay de tao duoc " (itoa n) " points"))
)

Sau khi chạy thì : " Mat thoi gian la: 0.328 giay de tao duoc 871 points"

@ bác Ha : bác thay dòng 20 ở dòng này thành 50

(setq lis (select-c (getvar "extmin") (getvar "extmax") 20 '((0 . "LINE"))))

tức 1 ô có 20 đt thành 1 ô có 50 đt

Hi Ngamy, thuật toán của bạn nhanh hơn nhưng bị lỗi: lisp tentpoint không tạo điểm tại 2 vị trí (588354.256,1181945.211) và (588557.766, 1182018.526). Nếu bạn hoàn chỉnh lisp của bạn để tạo thêm 2 điểm ở trên nữa thì đúng 873 điểm!. Lúc đó thời gian chạy lisp sẽ khác ngay.

[TRUNGNGAMY 91]

Hi Ngamy, thuật toán của bạn nhanh hơn nhưng bị lỗi: lisp tentpoint không tạo điểm tại 2 vị trí (588354.256,1181945.211) và (588557.766, 1182018.526). Nếu bạn hoàn chỉnh lisp của bạn để tạo thêm 2 điểm ở trên nữa thì đúng 873 điểm!. Lúc đó thời gian chạy lisp sẽ khác ngay.

Việc tìm ra 873 hay 871 thường do sai số nhỏ của một vài điểm tọa độ, việc cho ra kq 871 hay 873 đôi lúc cũng gây khó hiểu. VD với hàm trên nếu mình kiểm tra bẳng tọa độ thì nó tạo 871 đểm, nếu chuyển tọa độ thành chuỗi với 3 số lẽ vẫn cho 871 điểm nhưng với 2 số lẽ cho 873 điểm. Thật khó hiểu. Nhưng thời gian thì kg thay đổi lắm. Từ 0.328 lên 0.360s. Đây là code mới :

(defun c:tendpoint( / ss i n name p10 p11 lis1 lis2 s10 s11)
 (defun pointtostr( p)
(strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2))
 )
 (defun diem( name n)
(cdr (assoc n (entget name)))
 )
 (setq tg (getvar "millisecs"))
 (setq ss (ssget "x" '((0 . "line"))))
 (if ss (progn
(setq i 0 L (sslength ss) lis1 nil lis2 nil n 0)
(while (< i L)
 	(setq name (ssname ss i))
 	(setq p10 (diem name 10) p11 (diem name 11) s10 (pointtostr p10) s11 (pointtostr p11))
 	(if (null (assoc s10 lis1)) (setq lis1 (append lis1 (list (list s10)))) (if (null (assoc s10 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
                	(entmake (list (cons 0 "POINT") (cons 10 p10)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list s10))))))
 	)
 	(if (null (assoc s11 lis1)) (setq lis1 (append lis1 (list (list s11)))) (if (null (assoc s11 lis2)) (progn
                                                                                                                                                 	(setq n (1+ n))
                	(entmake (list (cons 0 "POINT") (cons 10 p11)))
                                                                                                                                                 	(setq lis2 (append lis2 (list (list s11))))))
 	)
 	(setq i (1+ i))
)
 ))
 (print (strcat " Mat thoi gian la: " (rtos (/ (- (getvar "millisecs") tg) 1000.0) 2 3) " giay de tao duoc " (itoa n) " points"))
)

Tuy nhiên, code trên chỉ nhanh khi bv nhỏ thôi. Nếu bv lớn việc tạo nhiều list sẽ làm tốc độ giảm đáng kể.

Bây giờ nếu bạn nào cảm thấy đầu óc quá nhàm chán hãy thử tìm giao (chứ kg phải điểm đầu và cuối line, -mình có thể kéo dài các line ra 1 đoạn để chúng chỉ cắt nhau) của bv 42200đt ở #6 sao cho nó có thể chạy với hiệu suất từ 350s (chạy theo code chia ô kết hợp tìm giao của bác Ha mà mình đã post ở #89) giảm đến 250s hay ít hơn nữa (tuỳ máy) , với khoảng 35680 điểm đc tạo. Máy mình đạt đc hiện nay là từ 350s xuống 250s, mình sẽ cố gắng giảm xuống tiếp. Mình sẽ test trên máy mình để đánh giá. Các bạn có thể nhào nặn từ bất cứ code nào tìm đc tính tử đây trở về trước. Bạn nào cảm thấy buốn thì nhào zdô. Sau 3 ngày mình sẽ post đáp án lên

[TRUNGNGAMY 91]

Cám ơn tất cả mọi người. Nhờ code của các bạn mình đã nhào nặn xuống dưới 30''. Có lẽ tạm nghỉ ít hôm để tập trung vào công việc. Mình sẽ trở lại với đề tài liên quan và hấp dẫn hơn.

[TRUNGNGAMY 91]

Cám ơn tất cả mọi người. Nhờ code của các bạn mình đã nhào nặn xuống dưới 30''. Có lẽ tạm nghỉ ít hôm để tập trung vào công việc. Mình sẽ trở lại với đề tài liên quan và hấp dẫn hơn.

Trước khi nói đến chủ đề mới mình sẽ đưa cái đáp án cũ lên để các bạn tham khảo. Dưới đấy là code tìm và chèn point vào vị trí giao các đối tượng. Khi thực hiện trên bv có 42200đt ở #6 chỉ mất dưới 30''. Có thể đây là kết quả khó có thể đạt đc nếu kg có PP chia ô và một số PP khác. Các bạn có thể thắc mắc tại sao mình cứ quần tới quần lui vđ này, vì nó là nội dung chính (nói cx hơn là công đoạn chính của chủ đề tiếp theo) nên mình muốn nó thật chuẩn và thật nhanh. Đoạn code dưới đây sd PP chia ô của bác Thai, PP tìm giao của bác Ha và một ít công sức của mình.

(vl-load-com)
 (defun pointtostr( p)
(strcat (rtos (car p) 2 2) " " (rtos (cadr p) 2 2))
 )
;Ham kiem tra vi tri ddiem va HCN
(defun diemvaHCN( p1 p2 p / x y x1 y1 x2 y2 k)
 (setq x (car p) y (cadr p) x1 (car p1) y1 (cadr p1) x2 (car p2) y2 (cadr p2))
 (if (> x1 x2) (setq k x1 x1 x2 x2 k))
 (if (> y1 y2) (setq k y1 y1 y2 y2 k))
 (cond
((if (or (< x x1) (< y y1) (> x x2) (> y y2)) 1))
((if (and (> x x1) (< x x2) (> y y1) (< y y2)) -1))
(T 0)
 )
)
;Doan nay cua bac Thai
(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))))))

;Doan nay cua bac Doan Van Ha
(defun c:HATG2 ( / lis lis1 i dt p1 p2 Tapchon lis2 liskt liskt2 n tg x)
 (defun GIAOSS-2 (ss / a i j objlst lst)
(setq i (sslength ss))
(setq objlst (SS->objlst-2 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-2 (vlax-invoke a 'IntersectWith (nth j objlst) acExtendNone)) lst))
 	)
)
lst
;	(LM:Unique-2 (apply 'append lst))
 )
 (defun NHOM3-2 (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-2 (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-2 ( l )
(if l (cons (car l) (LM:Unique-2 (vl-remove (car l) (cdr l)))))
 )
 (setq tg (getvar "millisecs"))
 (setvar "osmode" 0)
 (setq lis (select-c (getvar "extmin") (getvar "extmax") 30 '((0 . "LINE"))))
 (setq i 0 liskt2 nil n 0)
 (while (< i (length lis))
(setq dt (nth i lis) p1 (car dt) p2 (cadr dt) liskt nil)
(setq TapChon (ssget "c" p1 p2 '((0 . "line"))))
(setq lis1 (giaoss-2 TapChon))
(setq j 0 L (length lis1))
(foreach x lis1 (if x (progn (setq x (car x))
 	(cond
   	((= (diemvaHCN p1 p2 x) 0)
	(if (null (ASSOC (pointtostr x) liskt2)) (progn
  		(setq liskt2 (append liskt2 (LIST (list (pointtostr X)))))
  		(entmake (list (cons 0 "point") (cons 10 X)))
  		(setq n (1+ n))
	))
   	)
   	((< (diemvaHCN p1 p2 x) 0)
	(if (null (ASSOC (pointtostr x) liskt)) (progn
  		(setq liskt (append liskt (LIST (list (pointtostr X)))))
  		(entmake (list (cons 0 "point") (cons 10 X)))
  		(setq n (1+ n))
	))
   	)
 	)
)))

Code trên chỉ có một vđ nhỏ như mình và bác Thai đã nêu ở PP chia ô. Nếu tập chọn kg có đối tượng thì vòng lặp kg thoát. Mình cũng muốn chỉnh lại đoạn này cho nó an toàn hơn nhưng chưa làm đc. Bác Thai hoặc bạn nào có thể thì chỉnh giúp cho nó thoát khi kg chọn đc đt nào.

 

Chủ đề 4 : Viết Lệnh tạo đường bao tương tự lệnh boundary của Cad (nhưng cách làm hoàn toàn khác).

Tại sao lại viết lại lệnh này khi Cad đã có. Vì những lý do sau :

- Lệnh Cad chạy kg được những TH phức tạp

- Thông tin trả về chưa đầy đủ.

Phần lớn các bạn đều biết lệnh boundary của Cad chỉ tính tốt trong TH các đối tượng tương đối thoáng, còn lại thường báo lỗi. Đã có nhiều lần một số cao thủ muốn viết lại lệnh này nhưng chưa đủ kiên trì. Hôm nay mình muốn nhờ các bạn hỗ trợ hết mình để viết lại lệnh này, thậm chí nó sẽ có thể chạy tốt hơn và nhanh hơn Cad, thông tin đưa về cũng nhiều hơn. Mình sẽ đưa ra một số yêu cầu tương đối khó, mong tìm đc những đoạn code tốt nhất để ráp lại thành một lệnh hoàn chỉnh. Để viết đc lệnh trên cần rất nhiều thứ. Nếu đưa ra nhiều yêu cầu một lúc sẽ làm rối vđ và các bạn cũng ngán. Trước hết mình nhờ các bạn giúp :

- Lập danh sách quản lý tọa độ điểm giao và các đối tượng giao tại điểm này (lưu trong biến toàn cục). Mục đích để truy xuất các đối tượng giao nhau tại một điểm bất kỳ khi cung cấp tọa độ của nó.

Đây là hàm rất quan trọng nên rất cần sự chuẩn xác và tốc độ. Mong các cao thủ ra tay.

Theo mình thì có thể lưu danh sách tọa độ và đối tượng như sau : lis=((p1 h1 h2 h3) (p2 h1 h4 h5) ...) (trong đó pi là tọa độ, hi : mã dxf=5 của đt)

Khi dùng hàm truy xuất có dạng AAA( p lis) (assoc p lis)). Khi gọi (AAA p) -> (p h1 h2 h3)

Đó là suy nghĩ của mình. Còn cách nào hay hơn tùy các bạn.

 

Thực ra lệnh này trước đây mình đã viết bằng lisp và arx, tuy nhiên mình chỉ đủ sức viết với dữ liệu line và cũng chưa thật tốt, nhưng mình hoàn toàn làm chủ đc nó. Hôm nay có Cadviet hỗ trợ hy vọng sẽ cùng nhau viết đc một lệnh chạy trên nhiều loại đối tượng như lệnh của Cad nhưng mức độ sâu hơn và hoàn chỉnh hơn. Cám ơn các bạn trước.

 

P/S : Theo góp ý của bác Thai ở dưới, chủ đề này đã được lập riêng ở đây : http://www.cadviet.com/forum/index.php?showtopic=65055

[Thaistreetz 539]

Code trên chỉ có một vđ nhỏ như mình và bác Thai đã nêu ở PP chia ô. Nếu tập chọn kg có đối tượng thì vòng lặp kg thoát. Mình cũng muốn chỉnh lại đoạn này cho nó an toàn hơn.

Hình như bác có nhầm lẫn gì đó ở đây. trong code đó em có hàm kiểm tra điều kiện tập chọn có đối tượng ngay từ đầu rồi mà

(defun select-c (p1 p2 n filter / ss)

(if (setq ss (ssget "c" p1 p2 filter))

(thân hàm)

))

rõ ràng nếu ss = nil thì hàm kết thúc luôn chứ không có nhảy vào thân hàm để lặp tiếp.

 

Chủ đề mới này của bác em nghĩ nên tách ra 1 topic riêng được rồi bác ạ. Bác có thể để 1 liên kết đến topic này trong trường hợp có gì đó liên quan. như thế tiện theo dõi hơn.

lệnh boundary đúng là khiến nhiều người phải bức xúc thật. Đây sẽ là vấn đề nhiều người quan tâm, tiêu đề của topic hiện tại không có gì liên quan đến chủ đề này nữa rồi.

em cũng nhiều lần bức xúc quá mà đi mò xem có cách nào thay thế nó không nhưng giờ vẫn chào thua. Hi vọng các bác chung tay làm được. em lót dép hóng, chờ kết quả :D

[TRUNGNGAMY 91]

Hình như bác có nhầm lẫn gì đó ở đây. trong code đó em có hàm kiểm tra điều kiện tập chọn có đối tượng ngay từ đầu rồi mà

(defun select-c (p1 p2 n filter / ss)

(if (setq ss (ssget "c" p1 p2 filter))

(thân hàm)

))

rõ ràng nếu ss = nil thì hàm kết thúc luôn chứ không có nhảy vào thân hàm để lặp tiếp.

Có lẽ mình diễn tả kg rõ, ý mình muốn nói là làm thế nào cho hàm này kg bị "treo" khi mình chọn số đối lượng trong 1 ô khá nhỏ như TH đã gặp. Có thể dùng biện pháp nào đó để khắc phục. Vì việc chọn số đối tượng lớn thì an toàn hơn (tuy nhiên cũng chưa chắc là tuyệt đối trong mọi TH) nhưng nó chạy chậm hơn. Phiền bác giúp cho. Cám ơn bác