[Yêu cầu] Viết Lệnh tạo đường bao tương tự lệnh boundary của Cad

[TRUNGNGAMY 91]

Mình dự định Viết lệnh này chung chủ để "Phân nhỏ tập hợp chọn bằng cách chia ô" vì nó sẽ sd kiến thức ở đây

http://www.cadviet.com/forum/index.php?showtopic=64615&pid=204672&st=80&&do=findComment&comment=204672

nhưng theo ý kiến của bác Thai thì nên lập riêng. Thì mình theo các bạn vậy, cùng nhau lập ra lệnh này.

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.

[Doan Van Ha 3.180]

Kể ra thì cũng vất vả khi phải giải bài toán của bác Trung_Nga_Mỹ(???).

Tôi không có bản vẽ lớn để kiểm tra nhiều, do đó bác test xem sao nhé, nhất là khoản tốc độ.

Lisp: tạo danh sách các giao điểm của tập hợp chọn, kèm Handle của các đối tượng giao tương ứng tại từng điểm.

;Doan Van Ha - CADViet.com - Ngay 04/7/2012
;Muc dich: List c¸c giao ®iÓm cña Set, kÌm Handle cña c¸c ®èi t­îng giao t­¬ng øng t¹i tõng ®iÓm.
(defun C:HA()
(setq ss (ssget))
(HA:LstInterSet ss))
;-----
(defun HA:LstInterSet (ss / obj1 obj2 i j lst)
(setq i (sslength ss))
(while (>= (setq j (1- i) i (1- i)) 0)
 (setq obj1 (vlax-ename->vla-object (ssname ss i)))
 (while (>= (setq j (1- j)) 0)
  (setq obj2 (vlax-ename->vla-object (ssname ss j))
        	lst (cons (HA:LstInter2Obj obj1 obj2) lst))))
(setq lst (apply 'append lst))
(foreach x (setq z lst)
 (foreach y (setq z (cdr z))
  (if (equal (car x) (car y) 1E-8)
(progn
	(setq lst (subst (LM:Unique (append x (cdr y))) x lst))
	(setq x (LM:Unique (append x (cdr y))))
	(setq lst (vl-remove y lst))))))
lst)
;----- List c¸c giao ®iÓm cña 2 Objs.
(defun HA:LstInter2Obj (obj1 obj2 / lst1 lst2 h1 h2)
(setq h1 (vla-get-handle obj1) h2 (vla-get-handle obj2))
(setq lst1 (vlax-invoke obj1 'IntersectWith obj2 acExtendNone))
(while lst1
 (setq lst2 (cons (list (list (car lst1) (cadr lst1) (caddr lst1)) h1 h2) lst2))
 (setq lst1 (cdddr lst1)))
(reverse lst2))
;----- List gåm c¸c phÇn tö kh¸c nhau.
(defun LM:Unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))

[TRUNGNGAMY 91]

Kể ra thì cũng vất vả khi phải giải bài toán của bác Trung_Nga_Mỹ(???).

Tôi không có bản vẽ lớn để kiểm tra nhiều, do đó bác test xem sao nhé, nhất là khoản tốc độ.

Lisp: tạo danh sách các giao điểm của tập hợp chọn, kèm Handle của các đối tượng giao tương ứng tại từng điểm.

;Doan Van Ha - CADViet.com - Ngay 04/7/2012
;Muc dich: List c¸c giao ®iÓm cña Set, kÌm Handle cña c¸c ®èi t­îng giao t­¬ng øng t¹i tõng ®iÓm.
(defun C:HA()
(setq ss (ssget))
(HA:LstInterSet ss))
;-----
(defun HA:LstInterSet (ss / obj1 obj2 i j lst)
(setq i (sslength ss))
(while (>= (setq j (1- i) i (1- i)) 0)
 (setq obj1 (vlax-ename->vla-object (ssname ss i)))
 (while (>= (setq j (1- j)) 0)
  (setq obj2 (vlax-ename->vla-object (ssname ss j))
    		lst (cons (HA:LstInter2Obj obj1 obj2) lst))))
(setq lst (apply 'append lst))
(foreach x (setq z lst)
 (foreach y (setq z (cdr z))
  (if (equal (car x) (car y) 1E-8)
(progn
(setq lst (subst (LM:Unique (append x (cdr y))) x lst))
(setq x (LM:Unique (append x (cdr y))))
(setq lst (vl-remove y lst))))))
lst)
;----- List c¸c giao ®iÓm cña 2 Objs.
(defun HA:LstInter2Obj (obj1 obj2 / lst1 lst2 h1 h2)
(setq h1 (vla-get-handle obj1) h2 (vla-get-handle obj2))
(setq lst1 (vlax-invoke obj1 'IntersectWith obj2 acExtendNone))
(while lst1
 (setq lst2 (cons (list (list (car lst1) (cadr lst1) (caddr lst1)) h1 h2) lst2))
 (setq lst1 (cdddr lst1)))
(reverse lst2))
;----- List gåm c¸c phÇn tö kh¸c nhau.
(defun LM:Unique (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))

Cám ơn bác Doan Van Ha đã hỗ trợ nhưng bác cần kết hợp với PP chia ô của bác Thái. Nếu kg có những giải pháp rút ngắn thời gian thì kg thể đặt vđ này đc. Hiện code của bác chạy trên bv khoảng 1000 line (chưa nói đến các đối tượng khác như đg tròn, elip ...) mất khoảng 80''. Mình nghĩ nếu bác kết hợp PP chia ô sẽ mất dưới 5''. Nếu bác bận để mình cố gắng lồng PP chia ô vào nhưng hơi lâu, tại mình kg quen các hàm vl lắm. Mình nghĩ ngoài PP chia ô còn phải sd PP phân mảnh biến nữa, nó tương tự như biến động

[TRUNGNGAMY 91]

Cám ơn bác Doan Van Ha đã hỗ trợ nhưng bác cần kết hợp với PP chia ô của bác Thái. Nếu kg có những giải pháp rút ngắn thời gian thì kg thể đặt vđ này đc. Hiện code của bác chạy trên bv khoảng 1000 line (chưa nói đến các đối tượng khác như đg tròn, elip ...) mất khoảng 80''. Mình nghĩ nếu bác kết hợp PP chia ô sẽ mất dưới 5''. Nếu bác bận để mình cố gắng lồng PP chia ô vào nhưng hơi lâu, tại mình kg quen các hàm vl lắm. Mình nghĩ ngoài PP chia ô còn phải sd PP phân mảnh biến nữa, nó tương tự như biến động

Hôm rồi chạy thử code của bác Ha mất 80'', thực ra chỉ mất 35'', kg biết máy mình nó bị gì, hôm nay nó chạy nhanh hơn. Tuy nhiên, như vậy vẫn là quá chậm so với công việc. Mình đã kết hợp PP chia ô và code của 1 bạn trên DD chế biến lại, cũng trên bv đó mất chỉ 2''. Mình đưa lên để các bạn tham khảo, nếu bác nào có thể cải tiến nhanh hơn thì xin giúp cho.

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

; lay phan tu theo so hieu tu thuc the
(defun diem( name n)
 (cdr (assoc n (entget name)))
)
;Ham lap ds diem va doi tuong giao tai diem
(defun rtoi( r)
 (fix (* 1000 (atof (rtos r 2 3))))
)
(defun prtoi( p)
 (list (rtoi (car p)) (rtoi (cadr p)))
)
;---------------------------------------------------------------------------------------------------------
(defun GiaoDT (ent1 ent2 / ob1 ob2 g kq sd)
 (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)
)
;tim giao tong hop
(defun timgiaodoituongbatky( / tg i j Li Lj ss n1 n2 k lis lisgjk n)
 (defun lapdsgiao1( lisgiao n1 n2 / p dl dl1)
(foreach m lisgiao (progn
 	(setq p (prtoi m))
 	(setq dl (assoc p listggiao))
 	(if (null dl) (setq listggiao (append listggiao (list (list p (diem n1 5) (diem n2 5))))) (progn
   	(setq dl1 nil)
   	(if (null (member (diem n1 5) dl)) (setq dl1 (append dl (list (diem n1 5)))))
   	(if (null (member (diem n2 5) dl)) (setq dl1 (append dl (list (diem n2 5)))))
   	(if dl1 (setq listggiao (subst dl1 dl listggiao)))
 	))
))
 )
 (setq tg (getvar "millisecs"))
 (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn
(setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box))
(setq lis (select-c p1 p2 50 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
;  	(print (strcat "\nDuoc chia thanh " (itoa (length ltd_lis)) " hinh"))
(setq i 0 Li (length lis) listggiao nil)
(while (< i Li)
 	(setq box (nth i lis) p1 (car box) p2 (cadr box))
 	(setq ss (ssget "c" p1 p2 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
 	(setq j 0 Lj (sslength ss))
 	(while (< j Lj)
   	(setq n1 (ssname ss j))
   	(setq k (+ j 1))
   	(while (< k Lj)
     	(setq n2 (ssname ss k))
     	(setq lisgjk (Giaodt n1 n2))
     	(if lisgjk (lapdsgiao1 lisgjk n1 n2))
     	(setq k (1+ k))
   	)
   	(setq j (1+ j))
 	)
 	(setq i (1+ i))
)
 ))
 (print (strcat "\nCo " (itoa (length listggiao)) " diem giao"))
(princ (/ (- (getvar "millisecs") tg) 1000.0))
(princ " giay.")
)
(defun c:vdtg()
 (timgiaodoituongbatky)
)
;---------------------------------------------------------------------------------------------------------

Phần tiếp theo của chủ đề này mình sẽ post trong nay mai, mong các bác tiếp sức

[TRUNGNGAMY 91]

Để đơn giản, trước hết ta xét các đối tượng giao nhau tại 2 đầu của chúng và kg có đối tượng bên trong. Sau khi chạy tốt sẽ xét TH các đối tượng giao nhau bất kỳ và có đối tượng kín bên trong. Như vậy sẽ phát sinh việc "cắt đối tượng" . Việc cắt đối tượng đã có Lisp "BreakObjects.lsp" của Charles Alan Butler. Tuy nhiên, Lisp này chạy lâu quá nên mình viết một Lisp khác làm công việc này. Code như sau :

;---------------------------------------------------------------------------------------------------------
;PP chia ô 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))))))

; lay phan tu theo so hieu tu thuc the
(defun diem( name n)
 (cdr (assoc n (entget name)))
)
;Ham lap ds diem va doi tuong giao tai diem
(defun rtoi( r)
 (fix (* 1000 (atof (rtos r 2 3))))
)
(defun prtoi( p)
 (list (rtoi (car p)) (rtoi (cadr p)))
)

;Ham giao d?i tu?ng c?a cadviet
(defun GiaoDT (ent1 ent2 / ob1 ob2 g kq sd)
 (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)
)
;------------------------------------------------------------------------------------------------------
;Ham tim giao cua 2 doi tuong bang PP chia o, sau do dua vao ham lapdsgiao1 de lapds giao diem giao va doi tuong giao tai diem
(defun lapdsdiemgiaovadtgiao( / tg i j Li Lj ss n1 n2 k lis lisgiao2dt n m)
;sd lenh trim de cat doi tuong theo ds doi tuong va diem giao
(defun breaktheodsdt( ds / h name p i ss L j Lj m)
 (setq m 0)
 (foreach n ds (progn
(setq h (car n) name (handent h) i 1 L (length n) ss (ssadd))
(ssadd name ss)
(while (< i L)
 	(setq p (nth i n) p (list (/ (car p) 1000.0) (/ (cadr p) 1000.0)))
 	(setq j 0 Lj (sslength ss) kt nil)
 	(while (and (null kt) (< j Lj))
   	(setq name (ssname ss j))
   	(setq p1 (vlax-curve-getClosestPointTo name  p))
;    	(print (list name p1 p))
   	(if (<= (distance p p1) 0.002) (progn
     	(command "_.break" name p p)
     	(setq name (entlast))
     	(ssadd name ss)
     	(setq kt T Lj (sslength ss))
     	(print (setq m (1+ m)))
   	))
   	(setq j (1+ j))
 	)
 	(setq i (1+ i))
)
 ))
)
;sd ham giao doi tuong de lap ds doi tuong giao va diem giao
 (defun lapdsgiaotheodt( lisgiao2dt n1 n2 / p dl dl1 h1 h2)
(foreach m lisgiao2dt (progn
 	(setq p (prtoi m) h1 (diem n1 5) h2 (diem n2 5))
 	(setq dl (assoc h1 listggiaotheodt))
 	(if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h1 p)))) (progn
   	(setq dl1 nil)
   	(if (null (member p dl)) (setq dl1 (append dl (list p))))
   	(if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt)))
 	))
 	(setq dl (assoc h2 listggiaotheodt))
 	(if (null dl) (setq listggiaotheodt (append listggiaotheodt (list (list h2 p)))) (progn
   	(setq dl1 nil)
   	(if (null (member p dl)) (setq dl1 (append dl (list p))))
   	(if dl1 (setq listggiaotheodt (subst dl1 dl listggiaotheodt)))
 	))
))
 )
;sd ham giao doi tuong de lap ds diem giao va doi tuong giao
 (defun lapdsgiaotheop( lisgiao2dt n1 n2 / p dl dl1)
(foreach m lisgiao2dt (progn
 	(setq p (prtoi m))
 	(setq dl (assoc p listggiaotheop))
 	(if (null dl) (setq listggiaotheop (append listggiaotheop (list (list p (diem n1 5) (diem n2 5))))) (progn
   	(setq dl1 nil)
   	(if (null (member (diem n1 5) dl)) (setq dl1 (append dl (list (diem n1 5)))))
   	(if (null (member (diem n2 5) dl)) (setq dl1 (append dl (list (diem n2 5)))))
   	(if dl1 (setq listggiaotheop (subst dl1 dl listggiaotheop)))
 	))
))
 )
 (setq tg (getvar "millisecs") m 0)
 (if (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))) (progn
(setq box (ACET-GEOM-SS-EXTENTS-FAST ss) p1 (car box) p2 (cadr box))
(setq lis (select-c p1 p2 50 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(setq i 0 Li (length lis) listggiaotheop nil listggiaotheodt nil)
(while (< i Li)
 	(setq box (nth i lis) p1 (car box) p2 (cadr box))
 	(setq ss (ssget "c" p1 p2 '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
 	(setq j 0 Lj (sslength ss))
 	(while (< j Lj)
   	(setq n1 (ssname ss j))
   	(setq k (+ j 1))
   	(while (< k Lj)
     	(setq n2 (ssname ss k))
     	(setq lisgiao2dt (Giaodt n1 n2))
;      	(if lisgiao2dt (lapdsgiaotheop lisgiao2dt n1 n2))
     	(if lisgiao2dt (lapdsgiaotheodt lisgiao2dt n1 n2))
     	(setq k (1+ k))
     	(print (setq m (1+ m)))
   	)
   	(setq j (1+ j))
 	)
 	(setq i (1+ i))
)
 ))
 (setvar "osmode" 0)
 (setvar "cmdecho" 0)
 (if listggiaotheodt (breaktheodsdt listggiaotheodt))
 (print (strcat "\nCo " (itoa (length listggiaotheodt)) " diem giao"))
 (princ (/ (- (getvar "millisecs") tg) 1000.0))
 (princ " giay.")
)
(defun c:vdtg()
 (lapdsdiemgiaovadtgiao)
)

So với BreakObjects.lsp, Lisp này chạy nhanh gấp 50 lần với khoảng 200 đối tượng (bao gồm line, pline, spline, arc ...) và 200 điểm giao (tức khoảng 18s so với 900s). Khi số đối tượng càng tăng thì tốc độ càng thấy rõ hơn. Tuy nhiên, mình chỉ viết để phục vụ việc tìm đường bao và cũng kg đủ kiến thức nên kg viết đầy đủ như BreakObjects.lsp. Mặt khác, khi viết lisp này, mình chưa hội đủ đk tốt nhất để viết hàm break mà sd hàm break của cad (mình đang nhờ các bạn giúp trên mục Thuật toán, ý tưởng). Có thể đây là điểm yếu của Lisp này (mình chỉ viết tạm để các bạn dễ tư vấn, mình chỉ viết TH các đối tượng là hở, các đối tượng kín như đường tròn, elip ... mình chưa viết đc). Nhờ các bạn xem qua và tư vấn, chỗ có lệnh "break". Cám ơn các bạn

[TRUNGNGAMY 91]

 

Hôm nay tiếp tục, các bạn nhìn hình trên. Mình dự định tìm đg bao theo hướng như sau :

1/ Đã tạo được ds quản lý đối tượng và điểm end của chúng.

- Đã có hàm quản lý đối tượng tại điểm end

- Đã có hàm trả vể các đối tượng giao tại một điểm.

- Đã có hàm cập nhật khi đối tượng thay đổi

Vấn đề tiếp theo là :

2/ Cung cấp một điểm, lập hàm tìm đc đối tượng gần nhất (giả sử cạnh 1-5)

3/ Từ đối tượng tìm đc trên (mục 2), nó có thể là (line, pline, arc, spline ...), theo chiều kim đồng hồ (qui ước vậy), căn cứ tập ss trả về tại cái điểm ở hướng tiến, ta phải tìm đối tượng tiếp theo tham gia vào cái đg đi. Ở đây, nếu là line thì đơn giản, arc còn có thể, nhưng spline thì hơi căng ... Mình chưa làm đc lệnh này.

4/ Giả sử hoàn thành (mục 3), đã tìm được đường đi và đã khép về điểm đầu (1-2-3-4-5), chuyển sang giai đoạn tính diện tích. Nếu toàn line thì quá dễ, TH có cả arc và spline thì làm thể nào. Mình cũng chưa làm được lệnh này.

Nhờ các bạn tham gia tư vấn, gợi ý cách làm lệnh tìm đg đi ở mục 3 và tình diện tích ở mục 4 với dữ liệu đã có ở mục 1 và 2. Cám ơn các bạn

[TRUNGNGAMY 91]

Để cho nhẹ, mình tập hợp và biên dịch các code ở trên thành file timduongbao.fas http://www.cadviet.com/upfiles/3/37170_timduongbao.rar cho nó gọn (tại vì trong file này mình viết lung tung kể cả những sưu tầm và đang thử nghiệm nên rất dài và rối, khi nào có code mới hoặc sau khi hoàn chỉnh mình sẽ lọc những hàm cần thiết rồi post lên). Nó có các hàm và lệnh sau :

- BD_QLDT : lệnh quản lý đối tượng line, arc, pline, spline ...

- BD_CNDT : lệnh cập nhật đối tượng khi bạn có thay đổi

- BD_SSDQ : lệnh trả về và tô đỏ tập ss tại điểm p (để kiểm tra hàm bd_ssqd)

- (defun bd_ssdq( p) ...) : hàm trả về tập ss (dạng list) tại điểm p

[TRUNGNGAMY 91]

Mình vừa mới dọn dẹp xong post lên để các bạn tiện tham khảo

(defun frac( real)
 (abs (- (abs real) (abs (fix real))))
)
; lay phan tu theo so hieu tu thuc the
(defun diem( name n)
 (cdr (assoc n (entget name)))
)
;Ham lap ds diem va doi tuong giao tai diem
(defun rtoi( r)
 (fix (* 1000 (atof (rtos r 2 3))))
)
(defun prtoi( p)
 (list (rtoi (car p)) (rtoi (cadr p)))
)
(defun C:BD_QLDT( / tg ss i name p10 p11 tg2 ls h)
 (setq tg (getvar "millisecs"))
 (setq ss (ssget "x" '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE"))))
 (if ss (progn
(setq i 0 L (sslength ss) m_bdqldt1 nil m_bdqldt2 nil)
(while (< i L)
 	(setq name (ssname ss i))
 	(setq ls (ACET-GEOM-OBJECT-END-POINTS name))
 	(setq p10 (car ls) p11 (cadr ls) p10 (prtoi p10) p11 (prtoi p11))
 	(setq m_bdqldt1 (append m_bdqldt1 (list (list name p10))))
 	(setq m_bdqldt2 (append m_bdqldt2 (list (list name p11))))
 	(setq i (1+ i))
)
 ))
 (princ (/ (- (getvar "millisecs") tg) 1000.0))
 (princ "s") (princ)
)
;Ham tim doi tuong tai diem bang bien dong
(defun bd_ssdq (P / ls)
 (setq p (prtoi p) ls nil)
 (foreach a m_bdqldt1 (if (equal p (cadr a)) (setq ls (append ls (list (car a))))))
 (foreach a m_bdqldt2 (if (equal p (cadr a)) (setq ls (append ls (list (car a))))))
 ls
)
(defun C:BD_SSDQ( / old p ls)
 (setq old (getvar "osmode"))
 (setvar "osmode" 1)
 (setq p (getpoint "\nPick") ls nil)
 (setvar "osmode" old)
 (if p (setq ls (bd_ssdq p)))
 (if ls (command "_.change" (acet-list-to-ss ls) "" "p" "c" 1 "") nil)
)
;Ham cn doi tuong sd bien dong  
(defun BD_CNDT ( ss / i L name p10 p11 ls dt)
 (setq i 0 L (sslength ss) dt nil)
 (while (< i L)
(setq name (ssname ss i))
(setq ls (ACET-GEOM-OBJECT-END-POINTS name))
(setq p10 (car ls) p11 (cadr ls) p10 (prtoi p10) p11 (prtoi p11))
(if (setq dt (assoc name m_bdqldt1)) (setq m_bdqldt1 (subst (list name p10) dt m_bdqldt1)))
(if (setq dt (assoc name m_bdqldt2)) (setq m_bdqldt2 (subst (list name p11) dt m_bdqldt2)))
(if (null dt) (progn
 	(setq m_bdqldt1 (append m_bdqldt1 (list (list name p10))))
 	(setq m_bdqldt2 (append m_bdqldt2 (list (list name p11))))
))
(setq i (1+ i))
 )
)
(defun C:BD_CNDT( / ss)
 (setq ss (ssget '((0 . "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE"))))
 (if ss (bd_cndt ss))
)
(vl-load-com)

[TRUNGNGAMY 91]

Ý tưởng sắp thành rồi. Mình đã chạy thử đối với TH toàn line, nhanh và độc hơn cad là cái chắc. Tốc độ kg thay đổi ở mọi độ zoom màn hình, đối tượng cần tìm đường bao kg cần nhìn thấy, kể cả cái điểm định vị đầu tiên, có thể chạy nhanh trên bv 50000đt. Hiện nay chỉ cần các bác hỗ trợ góp ý thêm cho TH có cung tròn, elip, spline nữa là có thể hoàn chỉnh. Các bạn nhìn hình bên dưới :

Xét tại điểm A gồm có line, arc, spline. Làm thế nào xuất phát từ cái line màu đỏ để tìm về cái line màu trắng. mình dự định tại a vẽ các đoạn thẳng thuộc curve cách A một đoạn sau đó xét góc như TH đoạn thẳng, nhưng mình chưa quen một số hàm vl để làm việc này cho nhanh. Bạn nào có thể giúp mình với.

Sau khi hình thành cái hình khép kin gồm line, arc, spline thì nên sd cách nào để tính diện tích. Nếu trả cho cad tạo dg bao rồi tính thì kg hay lắm

Cám ơn các bạn