Viết lisp theo yêu cầu [phần 2]

[tomboy 21]

Chào Bác Bình, Chào bạn hdt4151!!

Mình nói thì là nói vậy thôi chứ thực ra mình vẫn tiếp tục nghiên cứu tiếp yêu cầu của bạn.

Cuối cùng thì cũng có giải pháp cho bạn. Đúng với mọi trường hợp dùng line và pline thẳng.

Bác Bình thử xem code rất đơn giản mà mình không nghĩ ra sớm. Code này đang bị chậm phần repeat do chưa biết đặt điều kiện gì cho hợp lý.

Bạn hdt4151 và các bác test thử code rồi cho ý kiến.

(defun pro ()
(setq ss (ssget "x" '((0 . "line,lwpolyline"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
          (not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
          (not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq ss (ssget "x" '((0 . "*line"))))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
)

(defun c:tdd ()
(command "undo" "be")
(pro)
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
              (- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(if (/= (ssget "WP" ptlst) nil)
(progn 
(command "erase" name "")
(setq id (1- id))
(repeat (+ i 2)
(setq dlst1 (cdr dlst1))
)
)
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
)

Chào bạn phamngoctukts mình đã nghiên cứu kỹ lip của bạn rồi, bạn viết ngắn gọn rất hay, nhưng mình thấy bạn còn thiếu 1 điều kiện nữa đấy, thực ra bạn sử dụng Command Region cho một tập hợp chọn thì nó sẽ sinh ra rất nhiều đa giác đấy, nếu như vậy bạn phải thêm 1 đoạn mã để lọc các đa giác thừa ra nữa, để lọc được đa giác thừa thì phức tạp đây và nó sẽ làm cho chương trình của bạn kồng kềnh hơn nhiều. Cái thứ hai nữa theo mình nghĩ bạn không nên để chế độ bắt đối tượng một cách tự động được mà phải làm thủ công thì hay hơn vì nhiều khi bản vẽ lớn sẽ làm cho chương trình của ban chạy chậm, mình chạy thử của bạn rồi, bản vẽ của mình có tổng cộng 451 line thế mà mình không kiên nhẫn đợi nó chạy xong được. Cái thứ 3 là bạn nên thêm 1 dòng thông báo cho người dùng biết chương trình đã chạy xong và kết quả được lưu ở đâu. Bạn tiếp tục hoàn chỉnh đi nhé.Chúc bạn vui.

[Tue_NV 3.912]

Hình bao lớn nhất đc tạo ra cuối cùng. Bạn hãy xóa đi cái entlast. Đối với trường hợp có nhiều nhóm độc lập, bạn hãy chọn từng nhóm để thực hiện

Không hẳn như thế đâu bác TRUNGNGAMY ạ. Khi tạo Region thì hình bao lớn nhất chưa hẳn đã là được tạo ra cuối cùng. Đây là bằng chứng : http://www.mediafire.com/?96o4dc5y6oyhqfv :cheers:

Bác hãy thử tạo các Region đối với bản vẽ này và sẽ thấy được điều đó.

Nếu muốn xóa cái region bao ngoài cùng thì phải duyệt qua từng Region, tìm region nào có diện tích lớn nhất và xóa nó đi

[phamngoctukts 714]

@phamngoctukts: chào bạn, mình thực sự rất ấn tượng với kết quả lisp chạy, thanks bạn rất nhiều :cheers:

 

Lisp vẫn còn 1 lỗi nhỏ là khi tồn tại cạnh của 1 đa giác điểm nằm trên cạnh của 1 đa giác khác (2 cạnh không nhau) => lisp sẽ sinh ra 1 đa giác bao tất cả các đa giác lại (không thoã đk ban đầu là 1 đa giác không có đa giác khác nằm trong nó) => sẽ cho ra thừa 1 đa giác

 

File VD minh hoạ :

http://www.mediafire.com/download.php?v4vurleh577d6pr

Theo như file thì sẽ tìm được 5 đa giác nhưng lisp cho ra 6 đa giác (thêm 1 đa giác bao tất cả các đa giác lại)

 

Nếu những đường line gồm N nhóm nằm tách biệt nhau => sẽ tạo ra N đa giác thừa.

 

------

Ấy, mình post chậm quá, mọi người đã nói về lỗi trên hết rồi +_+

Chào bạn hdt4151. Mình đã fix loại bỏ được cái đa giác lớn nhất rồi. với các nhóm đa giác nằm tách biệt thì mình đưa ra phương án lựa chọn bằng tay (chưa nghĩ ra cách giải quyết vấn đề này).

Chào bạn phamngoctukts mình đã nghiên cứu kỹ lip của bạn rồi, bạn viết ngắn gọn rất hay, nhưng mình thấy bạn còn thiếu 1 điều kiện nữa đấy, thực ra bạn sử dụng Command Region cho một tập hợp chọn thì nó sẽ sinh ra rất nhiều đa giác đấy, nếu như vậy bạn phải thêm 1 đoạn mã để lọc các đa giác thừa ra nữa, để lọc được đa giác thừa thì phức tạp đây và nó sẽ làm cho chương trình của bạn kồng kềnh hơn nhiều. Cái thứ hai nữa theo mình nghĩ bạn không nên để chế độ bắt đối tượng một cách tự động được mà phải làm thủ công thì hay hơn vì nhiều khi bản vẽ lớn sẽ làm cho chương trình của ban chạy chậm, mình chạy thử của bạn rồi, bản vẽ của mình có tổng cộng 451 line thế mà mình không kiên nhẫn đợi nó chạy xong được. Cái thứ 3 là bạn nên thêm 1 dòng thông báo cho người dùng biết chương trình đã chạy xong và kết quả được lưu ở đâu. Bạn tiếp tục hoàn chỉnh đi nhé.Chúc bạn vui.

Các bạn thử cái này xem sao nhé.

;; free lisp from cadviet.com

(defun pro ()
(setq ss (ssget "x" '((0 . "lwpolyline"))))
(if (/= ss nil)
(repeat (sslength ss) (command "explode" ss)))
(setq ss (ssget '((0 . "line"))))
(repeat (sslength ss)
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(setq ss (ssget "x" '((0 . "*line"))))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while (< i (sslength list_pl))
(setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(setq delname boname))
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl))
)


(defun c:tdd ()
(command "undo" "be")
(pro)
(locbo)
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

[gia_bach 1.549]

Chào bạn hdt4151. Mình đã fix loại bỏ được cái đa giác lớn nhất rồi. với các nhóm đa giác nằm tách biệt thì mình đưa ra phương án lựa chọn bằng tay (chưa nghĩ ra cách giải quyết vấn đề này).

 

Các bạn thử cái này xem sao nhé.

(defun pro ()

...........

(setq ss (ssget '((0 . "line"))))

(repeat (sslength ss)

(setq i 0)

(while (< i (sslength ss))

..............

(setq ss (ssget "x" '((0 . "*line"))))

)

 

.....................

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.

(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)

Góp ý nhỏ : bạn chú ý hơn đến các hàm VisualLisp vì VisualLisp hỗ trợ tính giao điểm tốt hơn cũng như việc lấy diện tích của đối tuợng rất là đơn giản (như bắt cua trong hang vậy). :cheers:

 

............

Mình có một ý tưởng, chưa biết là trúng hay trật, song do đang kẹt quá chưa thực hiện được. Nếu có thể bác thử làm xem nhé.

1/- Lấy tập hợp các điểm cắt nhau của các line và pline. loại bỏ các điểm trùng nhau.

2/- Lặp qua tất cả các điểm này như sau:

Tại mỗi điểm lặp n bước xc định boundary với n điểm phân bố đều quanh điểm đó bằng lệnh polar.

Lấy tập hợp các boundary được tạo thành, lọc các boundary trùng nhau.

Lấy đỉnh của các boundary òn lại sau khi lọc

3/- áp dụng lisp tdd.

 

Như vậy sẽ tránh được việc bị trùng boundary bởi lệnh region như bác đã biết. Tuy nhiên có một nhược điểm là líp sẽ bỏ qua các boundary có kích thước nhỏ hơn bán kính polar và góc phân bố là 360độ/n. Do vậy người dùng cần lựa chọn n và bán kính polar cho phù hợp với yêu cầu và làm giảm thời gian xử lý của lisp.

..................

Chào bác Bình

Cá nhân tôi thấy ý tuởng này khá hay.

Chỉ xin bổ sung phần lọc boundary như sau :

- gọi tập SSboundary là tập các boundary đuợc tao ra.

- nếu điểm Pt không nằm trong các boundary này (SSboundary) -> tạo boundary tại điểm Pt.

(hàm này bạn Tuệ có viết rồi.)

Để khắc phục nhược điểm mà bác nêu, chúng ta gán bán kính polar bằng khoảng cách nhỏ nhất giữa các điểm trong tập điểm tìm đuợc ở buớc 1.

Về góc phân bố : vì thông thuờng thửa đất ít khi có góc nhỏ hơn 15 độ, nên tạm chọn góc = 15 độ

(nếu yêu cầu chính xác hơn thì chọn góc nhỏ xuống)

 

Gửi các bác hàm tìm tất cả giao điểm của tập chọn (*LINE,ARC,CIRCLE,ELLIPSE)

(defun c:test1 (/ ss)
 (vl-load-com)
 (if (setq ss (ssget (list (cons 0 "*LINE,ARC,CIRCLE,ELLIPSE") ))  )
   (foreach pt (getSS_Inter ss)
     (entmake (list (cons '0 "POINT")(cons '10 pt))) ))
 (princ))

(defun giao (ob1 ob2 / inter_lst iplist)
 (if (not (vl-catch-all-error-p
     (setq iplist (vl-catch-all-apply
		    'vlax-safearray->list
		    (list (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone) ))))))
   (progn
     (while (setq inter_lst (cons (list (car iplist) (cadr iplist) (caddr iplist)) inter_lst)
	   iplist (cdddr iplist)))
     (reverse inter_lst) ) ))

(defun getSS_Inter (ss / e giao_lst i lst obj tmp_lst)
 (setq i -1)
 (while (setq e (ssname ss (setq i (1+ i))))
   (setq lst (cons (vlax-ename->vla-object e) lst)) )
 (repeat (1- (vl-list-length lst))
   (setq obj (car lst))
   (foreach ob1 (setq lst (vl-remove obj lst ))
     (if (setq tmp_lst (giao ob1 obj))
(foreach pt tmp_lst
  (if (not (vl-position pt giao_lst))
    (setq giao_lst (cons pt giao_lst))))) ) )
 giao_lst )

[phamngoctukts 714]

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.

(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)

Góp ý nhỏ : bạn chú ý hơn đến các hàm VisualLisp vì VisualLisp hỗ trợ tính giao điểm tốt hơn cũng như việc lấy diện tích của đối tuợng rất là đơn giản (như bắt cua trong hang vậy). :cheers:

Hàm tìm giao điểm này bác bình đã áp dụng trong code của bác ấy rồi. Vì dùng để vẽ các thửa đất người vẽ ít khi sử dụng các đường cong để vẽ (em đang nghiên cứu phần ngắt đoạn của đường cong nhưng có lẽ là không cần thiết) mà toàn dùng pline thẳng là chính. Trong TH này chưa chắc dùng visualLisp nhanh hơn vì vẫn phải đặt các biến p1, p2, p3, p4 để làm điều kiện sét các điểm trùng nhau.

Vì mục đích của lisp này là xuất toạ độ các đỉnh nên sau khi xuất toạ độ đỉnh chỉ cần undo lại như ban đầu là ok. (sử dụng undo mark và back)

Thank bác đã góp ý!!!

[Tue_NV 3.912]

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.

(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)

......

Bạn Tú dùng "chiêu" "Ngược thời gian, trở về quá khứ, phút giây..." anh ạ :cheers:

thể hiện ở chổ này :

(defun c:tdd ()

(command "undo" "be")

.....

......

(command "undo" "e")

(command "undo" "")

Nếu dùng cái này, bạn phải bẫy lỗi, kẻo không User nhấn ESC giữa chừng thì hỏng hết

Tue_NV có góp ý như thế này :

1. Trong bản vẽ có nhiều đối tượng cần tạo Region và xuất tọa độ.

Khi xử lý với 1 nhóm đối tượng thôi thì Lisp xử lý toàn bộ các nhóm luôn. Tue_nv nghĩ là không nên vì làm chậm quá trình tính toán. Chọn 1 nhóm mà xử lý luôn cả nhóm thì chưa ổn lắm bạn ạ.

2. Nói về tốc độ, quả thật Lisp làm việc rất chậm, thao tác qua quá nhiều vòng lặp, Bạn cứ thử bản vẽ với khoảng hơn 100 đối tượng thì tốc độ chậm lắm. Nhiều nữa, e là đứng máy luôn

3. Về kết quả xuất thì nên sử dụng hàm getfiled là hay nhất. Vì có thể User muốn xuất sang các file khác nhau

4. Việc xử lý các nhóm khác nhau, có thể xử dụng phuơng án này :

--- Chọn đối tượng độc lập theo từng nhóm -> Cho vào 1 List. Duyệt qua tập chọn trong List đó và xử lý. Xem ra, hoàn thành được Lisp này phải tốn rất nhiều thời gian quá, bạn nhỉ? :cheers:

[phamngoctukts 714]

Bạn Tú dùng "chiêu" "Ngược thời gian, trở về quá khứ, phút giây..." anh ạ :cheers:

thể hiện ở chổ này :

(defun c:tdd ()

(command "undo" "be")

.....

......

(command "undo" "e")

(command "undo" "")

Nếu dùng cái này, bạn phải bẫy lỗi, kẻo không User nhấn ESC giữa chừng thì hỏng hết

Cái này thì em đang chờ bạn hdt4151 test đã xong mới hoàn thành lisp và cho bẫy lỗi vào. Vì bạn này hay đẻ trứng vàng lắm. Không biết còn muốn đẻ nữa không.

Tue_NV có góp ý như thế này :

1. Trong bản vẽ có nhiều đối tượng cần tạo Region và xuất tọa độ.

Khi xử lý với 1 nhóm đối tượng thôi thì Lisp xử lý toàn bộ các nhóm luôn. Tue_nv nghĩ là không nên vì làm chậm quá trình tính toán. Chọn 1 nhóm mà xử lý luôn cả nhóm thì chưa ổn lắm bạn ạ.

2. Nói về tốc độ, quả thật Lisp làm việc rất chậm, thao tác qua quá nhiều vòng lặp, Bạn cứ thử bản vẽ với khoảng hơn 100 đối tượng thì tốc độ chậm lắm

3. Về kết quả xuất thì nên sử dụng hàm getfiled là hay nhất. Vì có thể User muốn xuất sang các file khác nhau

4. Việc xử lý các nhóm khác nhau, có thể xử dụng phuơng án này :

--- Chọn đối tượng độc lập theo từng nhóm -> Cho vào 1 List. Duyệt qua tập chọn trong List đó và xử lý. Xem ra, hoàn thành được Lisp này phải tốn rất nhiều thời gian quá, bạn nhỉ? :cheers:

1. Em chưa hiểu ý này của Bác

2. Về tốc độ thì như em đã nói từ trước (vì non kinh nghiệm nên chưa tối ưu hoá cho lisp được) chủ yếu ở chỗ repeat đầu tiên (chưa biết đwtj điều kiện repeat bao nhiêu là đủ)

3. Do yêu cầu của bạn hdt4151 nên em chỉ xuất sang file txt. Em sẽ nghiên cứu thêm phần này để nhiều người khác còn dùng.

4. Cho em hỏi làm thế nào để chọn đối tượng theo từng nhóm? Giúp đỡ được người khác em thấy vui thời gian không thành vấn đề Bác ạ.

[Tue_NV 3.912]

Cái này thì em đang chờ bạn hdt4151 test đã xong mới hoàn thành lisp và cho bẫy lỗi vào. Vì bạn này hay đẻ trứng vàng lắm. Không biết còn muốn đẻ nữa không.

 

1. Em chưa hiểu ý này của Bác

2. Về tốc độ thì như em đã nói từ trước (vì non kinh nghiệm nên chưa tối ưu hoá cho lisp được) chủ yếu ở chỗ repeat đầu tiên (chưa biết đwtj điều kiện repeat bao nhiêu là đủ)

3. Do yêu cầu của bạn hdt4151 nên em chỉ xuất sang file txt. Em sẽ nghiên cứu thêm phần này để nhiều người khác còn dùng.

4. Cho em hỏi làm thế nào để chọn đối tượng theo từng nhóm? Giúp đỡ được người khác em thấy vui thời gian không thành vấn đề Bác ạ.

Ý thứ 1 là : Lisp của bạn bao giờ cũng xuất toạ độ của toàn bộ nhóm đối tượng. Trong khi đó, User chỉ muốn xuất chỉ 1 nhóm mà thôi. Mình chỉ chọn 1 nhóm để xử lý mà thôi, bạn à. Vì theo Tue_NV biết là sẽ có các nhóm thửa độc lập với nhau, không liên quan đến nhau.

Ý thứ 2 : Về việc xử lý trong Lisp của bạn, Tue_NV đọc qua thôi, chứ chua lấn sâu vô nhiều, nên không thể đưa ra lời góp ý cho bạn được. Bạn thông cảm. Chỉ có điều là việc xử lý điểm đầu và điểm cuối LINE của bạn rất hay

Ý thứ 3 : Hàm getfiled cho xuất ra hộp thoại và cho phép User lưu ở đâu? cho phép đặt tên khác nhau, và đương nhiên là sẽ lưu file sang .txt hay .xls

Ý thứ 4 :

Bạn có thể tham khảo cái này

(defun c:ndt(/ ss lst);Nhom doi tuong
(setq i 1)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa i)))
(while (setq ss (ssget))
(if ss (setq lst (append lst (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq i (1+ i)))))
)
(alert (strcat "\n Co " (itoa (length lst)) " nhom doi tuong duoc chon" (vl-princ-to-string lst)))
)

[hdt4151 1]

@bạn Tú: mình đã chạy thử lisp, kết quả đối với 1 nhóm đối tượng ra rất chính xác :cheers:

Phần đầu của lisp có lệnh chọn 1 nhóm đối tượng nhưng khi xuất ra thì xuất ra toàn bộ các nhóm và có hiện tượng thừa đa giác như lúc trước, bạn xem lại lỗi này xem sao nhé ^^

[phamngoctukts 714]

Ý thứ 1 là : Lisp của bạn bao giờ cũng xuất toạ độ của toàn bộ nhóm đối tượng. Trong khi đó, User chỉ muốn xuất chỉ 1 nhóm mà thôi. Mình chỉ chọn 1 nhóm để xử lý mà thôi, bạn à. Vì theo Tue_NV biết là sẽ có các nhóm thửa độc lập với nhau, không liên quan đến nhau.

Ý thứ 2 : Về việc xử lý trong Lisp của bạn, Tue_NV đọc qua thôi, chứ chua lấn sâu vô nhiều, nên không thể đưa ra lời góp ý cho bạn được. Bạn thông cảm. Chỉ có điều là việc xử lý điểm đầu và điểm cuối LINE của bạn rất hay

Ý thứ 3 : Hàm getfiled cho xuất ra hộp thoại và cho phép User lưu ở đâu? cho phép đặt tên khác nhau, và đương nhiên là sẽ lưu file sang .txt hay .xls

Ý thứ 4 :

Bạn có thể tham khảo cái này

(defun c:ndt(/ ss lst);Nhom doi tuong
(setq i 1)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa i)))
(while (setq ss (ssget))
(if ss (setq lst (append lst (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq i (1+ i)))))
)
(alert (strcat "\n Co " (itoa (length lst)) " nhom doi tuong duoc chon" (vl-princ-to-string lst)))
)

Thank bác! từ trước đến nay em cứ nghĩ nhóm selectionset không tạo thành list được.

[Tue_NV 3.912]

Thank bác! từ trước đến nay em cứ nghĩ nhóm selectionset không tạo thành list được.

Hì hì, hổng có chi. Làm chủ được tập chọn selectionset thì coi như làm chủ được "phần hồn" của AutoLisp. Hãy cố lên

 

@hdt4151 : Tue_NV thấy việc xuất kết quả ra thì việc kiểm tra việc xuất kết quả hơi bị khó khăn.

Tỉ dụ như : trong file txt như bạn Tú xuất thì có "hình thứ 1" ; Hình thứ 2,..... trong khi đó CAD chẳng có gì cả để kiểm chứng thì việc kiểm tra việc xuất kết quả hơi bị khó khăn đó. Nên chăng, nên viết thêm số thứ tự của hình vào trong CAD luôn để dễ kiểm tra việc xuất tọa độ giữa file CAD và txt?

[hdt4151 1]

@Tue_VN: đúng là hơi khó để kiểm tra với số lượng đa giác lớn, việc ghi số thứ tự của hình vào file cad là cần thiết (lại sinh ra quả trứng khác nữa rồi, cái này để bổ sung sau cùng cũng đc +_+).

1.Ghi số thứ tự vào giữa đa giác, mình không rõ thuật toán pick 1 điểm trong đa giác có khó k, nếu cần thiết có thể kết hợp dùng lisp tính trong tâm (có trong forum).

 

2.Kiểu chữ có thể có 2 lựa chọn : a. Nhập chiều cao chữ b. Pick vào text có sẵn, lấy định dạng của text đó để ghi vào đa giác.

[phamngoctukts 714]

@bạn Tú: mình đã chạy thử lisp, kết quả đối với 1 nhóm đối tượng ra rất chính xác :cheers:

Phần đầu của lisp có lệnh chọn 1 nhóm đối tượng nhưng khi xuất ra thì xuất ra toàn bộ các nhóm và có hiện tượng thừa đa giác như lúc trước, bạn xem lại lỗi này xem sao nhé ^^

Chào bạn hdt4151!

Lúc sửa lisp mình quên không sửa hết nên mới xảy ra lỗi như thế. Đã fix lại cho bạn rồi. Tại lúc test làm trên có 1 nhóm đối tượng thấy nó đúng thì port lên luôn. Bạn test lại lisp này.

;; free lisp from cadviet.com
(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa sn)))
(while (setq ss (ssget))
(if ss (setq lss (append lss (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq sn (1+ sn))) " hoac an Enter de ket thuc"))
)
(taobo)
)

(defun taobo ()
(setq k 0)
(while (< k (length lss))
(setq ss (nth k lss))
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while (< i (sslength list_pl))
(setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(setq delname boname))
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl) list_plmoi (append (list list_pl) list_plmoi))
)


(defun c:tdd ()
(inittdd)
(command "undo" "be")
(ndt)
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq h 0)
(while (< h (length list_plmoi))
(setq list_pl (nth h list_plmoi))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq h (1+ h))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

(defun inittdd ()
(setq 
    tdd_old_er *error*
    *error* tdderror
 )
)

(defun tdderror (errmsg)
(loitdd)
)


(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

[TRUNGNGAMY 91]

Không hẳn như thế đâu bác TRUNGNGAMY ạ. Khi tạo Region thì hình bao lớn nhất chưa hẳn đã là được tạo ra cuối cùng. Đây là bằng chứng : http://www.mediafire.com/?96o4dc5y6oyhqfv :cheers:

Bác hãy thử tạo các Region đối với bản vẽ này và sẽ thấy được điều đó.

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :

- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)

- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết

- Việc xuất ra file thì đơn giản hơn rồi

[phamngoctukts 714]

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :

- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)

- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết

- Việc xuất ra file thì đơn giản hơn rồi

Cách của bạn hơi bị dài mình thấy loại bỏ đa giác có diện tích lớn nhất là chuẩn nhất và mình đã áp dụng vào lisp rồi.

[TRUNGNGAMY 91]

Cách của bạn hơi bị dài mình thấy loại bỏ đa giác có diện tích lớn nhất là chuẩn nhất và mình đã áp dụng vào lisp rồi.

Đúng rồi. Nếu bạn chọn từng nhóm thì làm vậy là nhanh nhất. Nhưng nếu gặp TH bài toán lơn hơn thì có khó khăn vì mình nhớ hình như cad chỉ cho phép tạo đồng thời tối đa 128 tập hợp chọn mà thôi. Hoặc giả sử người dùng kg thích chọn từng nhóm hơi chậm và chưa thật sự tự động hoàn toàn. Cũng tùy công việc thôi

[Tue_NV 3.912]

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :

- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)

- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết

- Việc xuất ra file thì đơn giản hơn rồi

Cảm ơn bác TRUNGNGAMY đã đưa ra thuật toán. Bác có thể cho Tue_NV hỏi thêm chổ này được không?

thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài

Nếu có thể, Bác TRUNGNGAMY nói rõ hơn và có thể cho luôn 1 hình ảnh minh hoạ được không?

Cảm ơn bác rất nhiều

[pfievxd 6]

Em có 2 bài toán thế này nhé :

Bài toán 1:

Có n đường thẳng thuộc layer 01 giao với m cung tròn thuộc layer 02

Có sẵn 1 Block hình chữ nhật ( Cho nó dị hướng)

Yêu cầu : chèn Block theo các giao điểm (cái này em có thấy trên diễn đàn rồi) và Trục Block luôn trùng với trục của đường thẳng

Bài toán 2:

Có 3 pline (Hoặc nhiều hơn) thuộc các lớp khác nhau

Yêu cầu : Xác định đa giác khép kín tạo bởi các pline bằng cách hatch vào đa giác đó xong roài tính dt vùng hatch đó luôn thì càng tốt

Em học lisP được một tuần roài, bắt đầu biết sơ sơ, các bác cao thủ rảnh rỗi thì giúp em với, không thì định hướng cho em cái thuật toán cũng là quá tốt. Thanks các bác nhiều :cheers:

[hdt4151 1]

@phamngoctukts: mình chạy được rồi, rất tốt. Nhưng có 1 file của mình như thế này khi chạy lisp lại bị lỗi, copy sang file khác cũng bị lỗi luôn, mình không biết lí do là gì, bạn xem giúp mình nhé:

http://www.mediafire.com/download.php?ywd14e2g8qqm332

[phamngoctukts 714]

@phamngoctukts: mình chạy được rồi, rất tốt. Nhưng có 1 file của mình như thế này khi chạy lisp lại bị lỗi, copy sang file khác cũng bị lỗi luôn, mình không biết lí do là gì, bạn xem giúp mình nhé:

http://www.mediafire.com/download.php?ywd14e2g8qqm332

không down được bạn ơi.

[TRUNGNGAMY 91]

Cảm ơn bác TRUNGNGAMY đã đưa ra thuật toán. Bác có thể cho Tue_NV hỏi thêm chổ này được không?

thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài

Nếu có thể, Bác TRUNGNGAMY nói rõ hơn và có thể cho luôn 1 hình ảnh minh hoạ được không?

Cảm ơn bác rất nhiều

Cái này mính nghĩ cũng đơn giản thôi. Xét TH kg có cái đa giác bao ngoài (do bạn đã xóa đi) thì bạn thấy ngay kg có đa giác nào nằm trong đa giác nào cả (ở đây kg xét hình lồng nhau như đk của bạn gí đó đưa ra ban đấu) do đó bạn kg bao giờ tím đc trung điểm của 1 cạnh nào đó nằm trong một đa giác nào đó. TH tồn tại cái đa giác bao ngoài, xét TH đơn giản nhất là bạn có hai tam giác thì đa giác bao ngoài là 1 tứ giác, lúc này bạn sẽ tìm đc trung điểm của cạnh chung sẽ nắm trong đa giác. TH càng có nhiếu đa giác nằm trong đa giác bao ngoài thì càng nhiều trung điểm nằm trong đa giác bao ngoài hơn (mình chỉnh lại câu "tồn tại chỉ một trung điểm " thành "tồn tại ít nhất một trung điểm" cho nó chuẩn)

http://www.cadviet.com/upfiles/3/2_10.jpg

[hdt4151 1]

Mình kiểm tra link lại rồi, vẫn dowwn đc bình thường, có thể là do mạng ....

 

Link khác: http://www.cadviet.com/upfiles/3/f.dwg

[phamngoctukts 714]

Mình kiểm tra link lại rồi, vẫn dowwn đc bình thường, có thể là do mạng ....

 

Link khác: http://www.cadviet.com/upfiles/3/f.dwg

Hình của bạn bị lỗi chỗ giao giữa hai hình tại chỗ giao 3 đường thẳng các đầu đoạn thẳng không trùng nhau xinh ra lỗi do không tạo được region.

[phamngoctukts 714]

Hì hì, hổng có chi. Làm chủ được tập chọn selectionset thì coi như làm chủ được "phần hồn" của AutoLisp. Hãy cố lên

 

@hdt4151 : Tue_NV thấy việc xuất kết quả ra thì việc kiểm tra việc xuất kết quả hơi bị khó khăn.

Tỉ dụ như : trong file txt như bạn Tú xuất thì có "hình thứ 1" ; Hình thứ 2,..... trong khi đó CAD chẳng có gì cả để kiểm chứng thì việc kiểm tra việc xuất kết quả hơi bị khó khăn đó. Nên chăng, nên viết thêm số thứ tự của hình vào trong CAD luôn để dễ kiểm tra việc xuất tọa độ giữa file CAD và txt?

Thể theo yêu cầu của bác (đẻ trứng hộ bạn hdt4151) em đã hoàn thành lisp như sau. Bác test thử và cho ý kiến.

;; free lisp from cadviet.com


(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa sn)))
(while (setq ss (ssget))
(if ss (setq lss (append lss (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq sn (1+ sn))) " hoac an Enter de ket thuc"))
)
(taobo)
)

(defun taobo ()
(setq k 0)
(while (< k (length lss))
(setq ss (nth k lss))
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(setq ptam (centroid reg))
(setq list_tam (append (list ptam) list_tam))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while (< i (sslength list_pl))
(setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(progn 
(setq delname boname loaichu i)
)
)
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl) list_plmoi (append (list list_pl) list_plmoi) list_tam 
                 (vl-remove (nth loaichu (reverse list_tam)) list_tam))
)


(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
list_tam nil
)
(ndt)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq h 0)
(while (< h (length list_plmoi))
(setq list_pl (nth h list_plmoi))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq h (1+ h))
)
(setq dlst (reverse dlst))
(setq list_tam (reverse list_tam))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(setq i 0 ik 1)
(while (< i (length list_tam))
(setq chutam (nth i list_tam))
(command "text" "j" "m" chutam "" "" (rtos ik 2 0))
(setq i (1+ i) ik (1+ ik))
)
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

(defun inittdd ()
(setq 
    tdd_old_er *error*
    *error* tdderror
 )
)

(defun tdderror (errmsg)
(loitdd)
)


(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

(defun centroid (re / op ptam)
(vl-load-com)
(setq ob (vlax-ename->vla-object re)  
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
) 
)

[Tue_NV 3.912]

Thể theo yêu cầu của bác (đẻ trứng hộ bạn hdt4151) em đã hoàn thành lisp như sau. Bác test thử và cho ý kiến.

;; free lisp from cadviet.com
(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa sn)))
(while (setq ss (ssget))
(if ss (setq lss (append lss (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq sn (1+ sn))) " hoac an Enter de ket thuc"))
)
(taobo)
)

(defun taobo ()
(setq k 0)
(while ((setq ss (nth k lss))
(setq i 0)
(while ((setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while ((setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01)) 
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while ((setq reg (ssname ss i))
(setq ptam (centroid reg))
(setq list_tam (append (list ptam) list_tam))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while ((setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(progn 
(setq delname boname loaichu i)
)
)
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl) list_plmoi (append (list list_pl) list_plmoi) list_tam 
                 (vl-remove (nth loaichu (reverse list_tam)) list_tam))
)
(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1 
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
list_tam nil
)
(ndt)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq h 0)
(while ((setq list_pl (nth h list_plmoi))
(setq p 0)
(while ((setq name (ssname list_pl p) 
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 3) 
"\t"
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 3)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq h (1+ h))
)
(setq dlst (reverse dlst))
(setq list_tam (reverse list_tam))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(setq i 0 ik 1)
(while ((setq chutam (nth i list_tam))
(command "text" "j" "m" chutam "" "" (rtos ik 2 0))
(setq i (1+ i) ik (1+ ik))
)
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
)

(defun inittdd ()
(setq 
    tdd_old_er *error*
    *error* tdderror
 )
)

(defun tdderror (errmsg)
(loitdd)
)
(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

(defun centroid (re / op ptam)
(vl-load-com)
(setq ob (vlax-ename->vla-object re)  
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
) 
)

Hề hề. Sao bạn lại lầm lẫn giữa lời góp ý và yêu cầu vậy nhở?? :cheers: .

Tue_NV vô tình mang cái tội là "kích thích cho việc đẻ trứng rồi" :cheers: Thiện tai, thiện tai

1- Đã test. Kết quả chưa đạt. Vẫn chưa xoá được Boundary ngoài cùng thể hiện ở chổ : Khi chọn nhóm đối tượng có 2 số thứ tự ghi cùng trong 1 đa giác

2- Số thứ tự sắp xếp chưa đúng. Nên sắp xếp số thứ tự tăng dần trong cùng 1 nhóm

Kết quả test trên 1 số nhóm thửa

 

@Bác TRUNGNGAMY : Cảm ơn bác rất nhiều. Thuật toán rất hay :cheers: