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

[phamngoctukts 714]

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 giúp em test lại lần nữa nhé. Thank Bác.

;; 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 lc i)
)
)
(setq i (1+ i))
)
(if (eq loaichu 0) (setq loaichu (+ lc loaichu)) (setq loaichu (+ lc (- (sslength list_pl) 3) loaichu)))
(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
loaichu 0
)
(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]

Bác giúp em test lại lần nữa nhé. Thank Bác.

;; 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 lc i)
)
)
(setq i (1+ i))
)
(if (eq loaichu 0) (setq loaichu (+ lc loaichu)) (setq loaichu (+ lc (- (sslength list_pl) 3) loaichu)))
(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
loaichu 0
)
(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)))
) 
)

1. Vẫn bị lỗi như vậy. Tue_NV gửi file cho bạn test thử nhé :

http://s.cadviet.com/ec

2. Vì bạn trả về OSNAP về "quá sớm" nên Text bị "dính" vào cạnh của đa giác. Trả về "trễ trễ" 1 chút bạn ạ. Đúng thời điểm :cheers:

3. Thêm 1 chổ nữa là do bạn dùng chiêu "ngược thời gian, trở về quá khứ...undo" nên khi UNDO thì bản vẽ chưa trả về thời điểm ban đầu (trước khi viết Text được). Nên Sử dụng cái này trong trường hợp mà Lisper không tác động đến bản vẽ mà thôi

[gia_bach 1.549]

Bác giúp em test lại lần nữa nhé. Thank Bác.

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

Kết quả chạy nhanh khá ấn tuợng. :cheers:

Tuy nhiên

..........

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

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

 

Nếu có thể bổ sung tùy chọn lưu lại các đuờng bao thì tuyệt.

(để mà còn có cái giải trình với xếp hay khách hàng)

Đây là góp ý chứ không phải yêu cầu.

[phamngoctukts 714]

Kết quả chạy nhanh khá ấn tuợng. :cheers:

Tuy nhiên

 

 

Nếu có thể bổ sung tùy chọn lưu lại các đuờng bao thì tuyệt.

(để mà còn có cái giải trình với xếp hay khách hàng)

Đây là góp ý chứ không phải yêu cầu.

bác có thể giúp em kiểm tra xem tại sao text lại chạy không đúng không. Em nghĩ mọi thứ đều ổn thế mà vẫn báo sai (số thửa với file toạ độ đã xuất không khớp).

Còn việc xắp xếp text theo thứ tự thì tuỳ thuộc vào thứ tự tạo region.

[phamthanhbinh 3.146]

bác có thể giúp em kiểm tra xem tại sao text lại chạy không đúng không. Em nghĩ mọi thứ đều ổn thế mà vẫn báo sai (số thửa với file toạ độ đã xuất không khớp).

Còn việc xắp xếp text theo thứ tự thì tuỳ thuộc vào thứ tự tạo region.

Rất khâm phục bác Phamngoctukts, dã dày công làm ra các lisp như trên. Do mình đang khá bận nên chưa tham gia test được, kết quả thì mình chưa biết đã đúng ý bạn Hdt4151 hay chưa song có ti ti muốn góp ý với bác Phamngoctukts và các bác khác như sau:

1/- Các bác nên cố gắng trình bày cái lisp theo các dòng càng ngắn càng tốt. Điều này sẽ giúp cho việc hiển thị lisp trong khung code box gọn lại, tạo thuận lợi cho các thành viên khi tham khảo lisp. Tỷ như cái lisp của bác Pha5mngoctukts có những dòng code quá dài, khiến cho việc hiển thị nó trên màn hình của codebox vượt quá khổ. Khi đọc lisp phải chạy chuột qua lại rất ức chế vì có khi chỉ vì một vài dòng như vậy mà người đọc phải chạy chuột qua lại tới méo cả mồm các bác ạ.

Cũng vì lẽ này nên mình đã mạn phép bác Phamngoctukts tự edit các dòng code này thành hai hoặc ba dòng cho nó dễ đọc, mong các bác chớ giận.

2/- Thực tế việc viết lisp phụ thuộc khá nhiều vào ý tưởng hay còn gọi là giải pháp, hay thuật toán chi chi đó mà người viết lisp muốn áp dụng. Do vậy nên chăng các bác cung cấp cho người đọc biết trước ý tưởng hay thuật toán mà các bác sử dụng cho lisp để người đọc có thể dễ dàng hình dung khi đọc lisp, đồng thời cũng có thể mót được chút gì đó từ cái ý tưởng của các bác. Hề hề hề , hơi tham một chút, kiểu ăn mày lại còn đòi xôi gấc , mong các bác chớ giận nha.

 

Mình chưa có đủ thời gian để thực hiện cái ý tưởng đã nêu nhằm giải quyết bài toán của bạn hdt4151, sẽ cố gắng để thực hiện trong thời gian sớm nhất.

 

@ Bác Tue_NV: Có thể do cái văn cộc của mình nên bác chưa rõ cái ý tưởng của mình. song nó chỉ đơn giản là tại mỗi điểm giao nhau của các line hay polyline, bác sẽ dùng lệnh boundary để mà tạo các LWpolyline tại các điểm phân bố đều theo kiểu polar quanh cái điểm giao cắt đó, có thể là 8, 10, 12 hay n điểm tùy theo người dùng lựa chọn. Xét tập hợp các boundary được tạo thành này và loại bỏ các boundary trùng nhau bác sẽ có được các boundary được hình thành quanh cái điểm đang xét bác ạ.

Có bao nhiêu điểm giao cắt sẽ làm bấy nhiêu thằng giống như trên và loại bỏ các thằng boundary trùng thì bác sẽ có đủ số boundary cần tìm mà không lo cái vụ region bị trùm lên nhau.

Cái ngu ý của mình chỉ có vậy, tuy nhiên việc thực hiện nó thì chưa biết có được hay không vì việc lọc các boundary trùng nhau xem ra cũng chả dễ tí nào. Cái thằng boundary này nó cũng nhiều ngọng ngạnh lắm, chả dễ gì bắt nó chiều mình được. Nhược điểm của nó thì mình cũng đã nêu ra ở bài trước. Chỉ là mình nghĩ có thể chấp nhận được cái nhược điểm đó ở một phạm vi sử dụng nhất địng bác à. Hy vọng các bác sẽ có giải pháp tốt hơn.

 

Hề hề hề.....

[TRUNGNGAMY 91]

1. Vẫn bị lỗi như vậy. Tue_NV gửi file cho bạn test thử nhé :

http://s.cadviet.com/ec

2. Vì bạn trả về OSNAP về "quá sớm" nên Text bị "dính" vào cạnh của đa giác. Trả về "trễ trễ" 1 chút bạn ạ. Đúng thời điểm :cheers:

3. Thêm 1 chổ nữa là do bạn dùng chiêu "ngược thời gian, trở về quá khứ...undo" nên khi UNDO thì bản vẽ chưa trả về thời điểm ban đầu (trước khi viết Text được). Nên Sử dụng cái này trong trường hợp mà Lisper không tác động đến bản vẽ mà thôi

Không theo dõi từ đầu nên mình kg rõ, nhưng hình như bác hdt4151 định làm cái lệnh giống lệnh tạo vùng bên địa chính thì phải. Mình cũng test thử cho biết thì thầy khi gặp đa giác lõm khá nhiều thị cái tâm ghi text bị chạy ra ngoài hình. Cái này chắc các bạn đã biết. Muốn khắc phục nó mình nghĩ phải dùng đến lisp tìm vị trí trốing nhất trong đa giác mà trước đây bác NguyenHoanh đã lập cho tdvn

[phamngoctukts 714]

Rất khâm phục bác Phamngoctukts, dã dày công làm ra các lisp như trên. Do mình đang khá bận nên chưa tham gia test được, kết quả thì mình chưa biết đã đúng ý bạn Hdt4151 hay chưa song có ti ti muốn góp ý với bác Phamngoctukts và các bác khác như sau:

1/- Các bác nên cố gắng trình bày cái lisp theo các dòng càng ngắn càng tốt. Điều này sẽ giúp cho việc hiển thị lisp trong khung code box gọn lại, tạo thuận lợi cho các thành viên khi tham khảo lisp. Tỷ như cái lisp của bác Pha5mngoctukts có những dòng code quá dài, khiến cho việc hiển thị nó trên màn hình của codebox vượt quá khổ. Khi đọc lisp phải chạy chuột qua lại rất ức chế vì có khi chỉ vì một vài dòng như vậy mà người đọc phải chạy chuột qua lại tới méo cả mồm các bác ạ.

Cũng vì lẽ này nên mình đã mạn phép bác Phamngoctukts tự edit các dòng code này thành hai hoặc ba dòng cho nó dễ đọc, mong các bác chớ giận.

2/- Thực tế việc viết lisp phụ thuộc khá nhiều vào ý tưởng hay còn gọi là giải pháp, hay thuật toán chi chi đó mà người viết lisp muốn áp dụng. Do vậy nên chăng các bác cung cấp cho người đọc biết trước ý tưởng hay thuật toán mà các bác sử dụng cho lisp để người đọc có thể dễ dàng hình dung khi đọc lisp, đồng thời cũng có thể mót được chút gì đó từ cái ý tưởng của các bác. Hề hề hề , hơi tham một chút, kiểu ăn mày lại còn đòi xôi gấc , mong các bác chớ giận nha.

 

Hề hề hề.....

Chào Bác Bình! Thank Bác đã góp ý. Em xin sơ lược qua về nội dung lisp TDD.

1. Tìm tất cả Pline trên bản vẽ và explode ra

2. Chọn nhóm đối tượng line thành 1 selectionset và cho vào list

3. ngắt các line tại giao điểm

4. tạo region và loại bỏ region có diện tích lớn nhất.

5. tìm toạ độ trọng tâm của region để làm điểm chèn text

6. convert region thành pline

7. xuất toạ độ các đỉnh pline.

8. undo quay ngược thời gian vè lúc ban đầu

9. chèn text vào trọng tâm đa giác.

[phamngoctukts 714]

Không theo dõi từ đầu nên mình kg rõ, nhưng hình như bác hdt4151 định làm cái lệnh giống lệnh tạo vùng bên địa chính thì phải. Mình cũng test thử cho biết thì thầy khi gặp đa giác lõm khá nhiều thị cái tâm ghi text bị chạy ra ngoài hình. Cái này chắc các bạn đã biết. Muốn khắc phục nó mình nghĩ phải dùng đến lisp tìm vị trí trốing nhất trong đa giác mà trước đây bác NguyenHoanh đã lập cho tdvn

Cái này thì em cũng đã biết nhưng code tính vị trí trống nhất của bác Hoành và bác Tue_VN khá dài nên em không cho vào.

[tamkt 2]

Mấy a giúp em cái lisp này nha.

1. Em có một đoạn thẳng bất kì (ví dụ dài 2000mm)

2. Em nhập lệnh lisp ( ví dụ là: dv )

3. lisp yêu cầu nhập đoạn chia ( ví dụ là 500mm)

4. Em nhập 500

5. Kết quả là 4 ( vì 2000/500 = 4)

 

E Cám ơn mấy a trước nha. :cheers:

[phamngoctukts 714]

Mấy a giúp em cái lisp này nha.

1. Em có một đoạn thẳng bất kì (ví dụ dài 2000mm)

2. Em nhập lệnh lisp ( ví dụ là: dv )

3. lisp yêu cầu nhập đoạn chia ( ví dụ là 500mm)

4. Em nhập 500

5. Kết quả là 4 ( vì 2000/500 = 4)

 

E Cám ơn mấy a trước nha. :cheers:

Ý của bạn là chia đoạn thẳng thành từng đoạn cho trước hay là chỉ lấy kết quả hiển thị thôi.

[phamngoctukts 714]

bác có thể giúp em kiểm tra xem tại sao text lại chạy không đúng không. Em nghĩ mọi thứ đều ổn thế mà vẫn báo sai (số thửa với file toạ độ đã xuất không khớp).

Còn việc xắp xếp text theo thứ tự thì tuỳ thuộc vào thứ tự tạo region.

Chào các bác!

Cái này em tự đặt câu hỏi và đã tự trả lời được rồi. Code mới bổ xung thêm tính năng chọn đường dẫn để lưu file kết quả. Số thứ tự trên bản vẽ và trên file kết quả đã khớp với nhau.

;; 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 "")
(command "erase" 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")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
list_tam nil
loaichu 0
)
(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)
)
(setq ptam (centroid name))
(command "text" "j" "m" ptam "" "" (rtos id 2 0))
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)

(command "undo" "e")
(alert (strcat "file da duoc luu tai: " 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 (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re)  
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

[Tue_NV 3.912]

Chào các bác!

Cái này em tự đặt câu hỏi và đã tự trả lời được rồi. Code mới bổ xung thêm tính năng chọn đường dẫn để lưu file kết quả. Số thứ tự trên bản vẽ và trên file kết quả đã khớp với nhau.

;; 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 "")
(command "erase" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while ((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 ((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")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 nil
list_tam nil
loaichu 0
)
(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)
)
(setq ptam (centroid name))
(command "text" "j" "m" ptam "" (rtos id 2 0))
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)

(command "undo" "e")
(alert (strcat "file da duoc luu tai: " 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 (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re)  
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

Đã xảy ra lỗi

Select objects:

undo end undo xay ra loi trong qua trinh thao tác.

 

Tue_NV mới chỉ chọn 1 cái tứ giác thôi. Test trên 1 nhóm hay nhiều nhóm đối tượng cũng bị lỗi luôn <_>

[phamthanhbinh 3.146]

Chào các bác!

Cái này em tự đặt câu hỏi và đã tự trả lời được rồi. Code mới bổ xung thêm tính năng chọn đường dẫn để lưu file kết quả. Số thứ tự trên bản vẽ và trên file kết quả đã khớp với nhau.

 

Chào bác Phamngoctukts và các bác khác,

Như đã trình bày cái y tưởng ở bài trước, đây là cái lisp mình làm theo đúng cái ý tưởng đó. Do thời gian hơi bị bí nên mình chỉ dừng lại ở việc xuất ra một danh sách mà mỗi phần tử của nó là một tập hợp các tọa độ đỉnh của một boundary được tạo thành từ các line và lwpolyline giao cắt nhau như yêu cầu của bạn hdt4151. Từ danh sách này việc xuất tọa độ ra file text hay vẽ các text lên bản vẽ không còn là quá phức tạp nữa. Mình hy vọng bạn hdt4151 và các bác khác sẽ giải quyết nốt vấn đề còn lại chả mấy khó khăn gì.

Cũng do thời gian có hạn lại vừa làm vừa chỉnh sửa nên code viết chưa được trau chuốt lắm, rất mong các bác thông cảm và nếu có thể thì giúp mình sửa lại cho nó hoàn thiện hơn.

Code đã được test trên file bản vẽ của bạn hdt4151 gửi lên diễn đàn với nhiều phương án lựa chọn khác nhau đều cho kết quả ổn định và chính xác. Rất mong mọi người kiểm tra lại và góp ý để hoàn thiện thêm cho nó hữu ích.

Với code này hy vọng các bác sẽ thấy rõ cái ý đồ hơi chuối của mình, tuy nhiên nó cũng có thể cho cái kết quả không quá tệ so với yêu cầu. Cái nhược điểm của nó thì mình đã nói rồi. Tuy nhiên cũng xin bổ sung thêm tí chút nhược điểm nữa là : do code sử dụng lệnh boundary nên khi dùng các bác lưu ý là chỉ nên chọn một số lượng đối tượng vừa đủ để sao cho có thể thấy hoàn chỉnh các boundary trên màn hình. chớ có tham chọn số lượng đối tựơng quá lớn dẫn đến có các boundary không nằm trọn trong màn hình hoặc cái boundary bị thu quá nhỏ,. Điều này dễ dẫn tới lisp chạy không chính xác do cái lệnh boundary này không nhận dạng được các đường biên. Có nhẽ cái vụ này phải do anh cu Autodesk mới giải quyết triệt để được. Hề hề hề.......

 

Cái củ lisp ấy đây ạ

(defun c:xpatp ( / ss n i plst en1 en2 p1 j p pblst )
(command "undo" "be")
(setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE")))
        n (sslength ss)
        plst (list)
         i 0 )
(while (         (setq en1 (ssname ss i)
                  j 0)
        (while (and (                  (setq en2 (ssname ss j)
                         p1 (giao en1 en2)
                 )
                 (if (and (/= p1 nil) (= (member p1 plst) nil))
                     (setq plst (append plst (list p1)))
                 )
                 (setq  j (1+ j) )
        )
        (setq i (1+ i))
)
(setq enlst (list))
(foreach p plst
     (getbo p)
     (setq enlst (append pblst enlst))      
)
enlst
(lolst enlst)
(setq enlst pblst)
(command "undo" "e")
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun getbo ( pt / i a en polst enlst pdlst elst el )
;;;;;;;;;;;;;(command "undo" "be")
(setq oldos (getvar "osmode" ))
(setvar "osmode" 0)
(setq ;;;;;;;;;;;;;;;;;;;;;;;;;pt (getpoint "\n Chon giao diem")
       i 0
       enlst (list)
       pdlst (list)
       pblst (list)
)

(setq a (entlast))
(repeat 24
(setq polst (list))
(command "boundary" (polar pt (/ (* pi i ) 12) 1) "")
(setq en (entlast))
(if (= (equal a en) nil)
   (progn
   (setq elst (entget en))
   (foreach el elst
         (if (= (car el) 10)
             (setq polst (append (list (cdr el)) polst))
         )
    )
    )
)
(if (/= polst nil)
(setq pdlst (append (list polst) pdlst))
)
(setq i (+ i 1))
(setq a en)
)  
pdlst
(lolst pdlst)
pblst


(setvar "osmode" oldos)
;;;;;;;;;;;;;;;;;;(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename 
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(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
)
(if kq (setq gi (nth 0 kq)))
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lsteq (lst1 lst2 / m n i)
(setq n (length lst1)
       m (length lst2)
       thlst (list)
)
(setq i 0)
(if (= m n)
   (progn         
        (foreach a lst1
               (foreach b lst2
                    (if (equal a b 0.0000001)
                         (setq i (1+ i))
                    )
               )
        )
    )
)
(if (=  i  n)
   (setq kq T)
   (setq kq nil)    
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

(defun lolst ( lst / n k pklst )
(setq pblst (list))
(setq n (length lst)


)
(while (and (       (setq pblst (append (list (car lst)) pblst)
               pklst (list)
      )
      (foreach d (cdr lst)
             (lsteq (car lst) d)
             (if  kq
                 (setq n (- n 1))
                 (setq pklst (append pklst (list d)))
             )
       )
       (setq lst pklst)

       (setq n (1- n))
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;            

 

Chúc các bác luôn vui vẻ mạnh khỏe và yêu lisp yêu đời.

 

PS: Bác phamngoctukts có thể thấy dùng code này sẽ tránh được việc lầm lẫn giữa thứ tự text xuất ra và vị trí của các boundary. Bởi vì từ danh sách này bác có thể lần lượt duyệt qua từng thằng và chọn điểm ghi text của thằng nào vô trúng thằng đó, không lạc chuồng nữa bác ạ. Hề hề hề, lạc chuồng đôi khi cũng không mấy khoái bác nhỉ?????

 

@ Bạn hdt4151: Cái lisp này còn chưa tính tới các giao điểm nằm trên cạnh của các boundary bạn nhé. Việc bổ sung thêm những thằng này thì bạn có thể tham khảo ở cái lisp cũ của mình. Hề hề hề........

[phamngoctukts 714]

Đã xảy ra lỗi

Select objects:

undo end undo xay ra loi trong qua trinh thao tác.

 

Tue_NV mới chỉ chọn 1 cái tứ giác thôi. Test trên 1 nhóm hay nhiều nhóm đối tượng cũng bị lỗi luôn <_<

Thank bác đã test giúp. Em đã fix lại rồi.

;; free lisp from cadviet.com

;; 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 "")
(command "erase" 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))
)
(if (> (sslength list_pl) 1)
(progn
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl))
)
) 
(setq list_plmoi (append (list list_pl) list_plmoi)
)
)


(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 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)
)
(setq ptam (centroid name))
(command "text" "j" "m" ptam "" (rtos id 2 0))
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(alert (strcat "file da duoc luu tai: " file))
(startapp "notepad" 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 (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re) 
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

[phamngoctukts 714]

Chào bác Phamngoctukts và các bác khác,

Như đã trình bày cái y tưởng ở bài trước, đây là cái lisp mình làm theo đúng cái ý tưởng đó. Do thời gian hơi bị bí nên mình chỉ dừng lại ở việc xuất ra một danh sách mà mỗi phần tử của nó là một tập hợp các tọa độ đỉnh của một boundary được tạo thành từ các line và lwpolyline giao cắt nhau như yêu cầu của bạn hdt4151. Từ danh sách này việc xuất tọa độ ra file text hay vẽ các text lên bản vẽ không còn là quá phức tạp nữa. Mình hy vọng bạn hdt4151 và các bác khác sẽ giải quyết nốt vấn đề còn lại chả mấy khó khăn gì.

Cũng do thời gian có hạn lại vừa làm vừa chỉnh sửa nên code viết chưa được trau chuốt lắm, rất mong các bác thông cảm và nếu có thể thì giúp mình sửa lại cho nó hoàn thiện hơn.

Code đã được test trên file bản vẽ của bạn hdt4151 gửi lên diễn đàn với nhiều phương án lựa chọn khác nhau đều cho kết quả ổn định và chính xác. Rất mong mọi người kiểm tra lại và góp ý để hoàn thiện thêm cho nó hữu ích.

Với code này hy vọng các bác sẽ thấy rõ cái ý đồ hơi chuối của mình, tuy nhiên nó cũng có thể cho cái kết quả không quá tệ so với yêu cầu. Cái nhược điểm của nó thì mình đã nói rồi. Tuy nhiên cũng xin bổ sung thêm tí chút nhược điểm nữa là : do code sử dụng lệnh boundary nên khi dùng các bác lưu ý là chỉ nên chọn một số lượng đối tượng vừa đủ để sao cho có thể thấy hoàn chỉnh các boundary trên màn hình. chớ có tham chọn số lượng đối tựơng quá lớn dẫn đến có các boundary không nằm trọn trong màn hình hoặc cái boundary bị thu quá nhỏ,. Điều này dễ dẫn tới lisp chạy không chính xác do cái lệnh boundary này không nhận dạng được các đường biên. Có nhẽ cái vụ này phải do anh cu Autodesk mới giải quyết triệt để được. Hề hề hề.......

 

Cái củ lisp ấy đây ạ

(defun c:xpatp ( / ss n i plst en1 en2 p1 j p pblst )
(command "undo" "be")
(setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE")))
        n (sslength ss)
        plst (list)
         i 0 )
(while (< i n)
        (setq en1 (ssname ss i)
                  j 0)
        (while (and (< j n) (/= i j))
                 (setq en2 (ssname ss j)
                         p1 (giao en1 en2)
                 )
                 (if (and (/= p1 nil) (= (member p1 plst) nil))
                     (setq plst (append plst (list p1)))
                 )
                 (setq  j (1+ j) )
        )
        (setq i (1+ i))
)
(setq enlst (list))
(foreach p plst
     (getbo p)
     (setq enlst (append pblst enlst))      
)
enlst
(lolst enlst)
(setq enlst pblst)
(command "undo" "e")
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(defun getbo ( pt / i a en polst enlst pdlst elst el )
;;;;;;;;;;;;;(command "undo" "be")
(setq oldos (getvar "osmode" ))
(setvar "osmode" 0)
(setq ;;;;;;;;;;;;;;;;;;;;;;;;;pt (getpoint "\n Chon giao diem")
       i 0
       enlst (list)
       pdlst (list)
       pblst (list)
)

(setq a (entlast))
(repeat 24
(setq polst (list))
(command "boundary" (polar pt (/ (* pi i ) 12) 1) "")
(setq en (entlast))
(if (= (equal a en) nil)
   (progn
   (setq elst (entget en))
   (foreach el elst
         (if (= (car el) 10)
             (setq polst (append (list (cdr el)) polst))
         )
    )
    )
)
(if (/= polst nil)
(setq pdlst (append (list polst) pdlst))
)
(setq i (+ i 1))
(setq a en)
)  
pdlst
(lolst pdlst)
pblst


(setvar "osmode" oldos)
;;;;;;;;;;;;;;;;;;(command "undo" "e")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;Ham tim giao diem giua 2 doi tuong ent1, ent2 ; ename 
(defun giao(ent1 ent2 / ob1 ob2 g kq sd)
(Vl-Load-Com)
(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
)
(if kq (setq gi (nth 0 kq)))
) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun lsteq (lst1 lst2 / m n i)
(setq n (length lst1)
       m (length lst2)
       thlst (list)
)
(setq i 0)
(if (= m n)
   (progn         
        (foreach a lst1
               (foreach b lst2
                    (if (equal a b 0.0000001)
                         (setq i (1+ i))
                    )
               )
        )
    )
)
(if (=  i  n)
   (setq kq T)
   (setq kq nil)    
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  

(defun lolst ( lst / n k pklst )
(setq pblst (list))
(setq n (length lst)


)
(while (and (< 0 n) (/= lst nil))
      (setq pblst (append (list (car lst)) pblst)
               pklst (list)
      )
      (foreach d (cdr lst)
             (lsteq (car lst) d)
             (if  kq
                 (setq n (- n 1))
                 (setq pklst (append pklst (list d)))
             )
       )
       (setq lst pklst)

       (setq n (1- n))
)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;            

 

Chúc các bác luôn vui vẻ mạnh khỏe và yêu lisp yêu đời.

 

PS: Bác phamngoctukts có thể thấy dùng code này sẽ tránh được việc lầm lẫn giữa thứ tự text xuất ra và vị trí của các boundary. Bởi vì từ danh sách này bác có thể lần lượt duyệt qua từng thằng và chọn điểm ghi text của thằng nào vô trúng thằng đó, không lạc chuồng nữa bác ạ. Hề hề hề, lạc chuồng đôi khi cũng không mấy khoái bác nhỉ?????

 

@ Bạn hdt4151: Cái lisp này còn chưa tính tới các giao điểm nằm trên cạnh của các boundary bạn nhé. Việc bổ sung thêm những thằng này thì bạn có thể tham khảo ở cái lisp cũ của mình. Hề hề hề........

Chào Bác Bình.

Sao em down code của bác về nó bị mất đoạn sau từ chỗ tìm giao điểm. Em phải copy bằng tay vào. Nhưng code chạy xong chẳng báo gì cả nên không biết code đã xử lý những gì. Bác dùng cách pick 24 lần quanh 1 điểm (cái này khá mất thời gian nếu object trong bản vẽ lớn). Em đọc code nên biết vậy thôi còn có thể do file down về bị lỗi không test được.

[phamngoctukts 714]

Chào Bác Bình.

Sao em down code của bác về nó bị mất đoạn sau từ chỗ tìm giao điểm. Em phải copy bằng tay vào. Nhưng code chạy xong chẳng báo gì cả nên không biết code đã xử lý những gì. Bác dùng cách pick 24 lần quanh 1 điểm (cái này khá mất thời gian nếu object trong bản vẽ lớn). Em đọc code nên biết vậy thôi còn có thể do file down về bị lỗi không test được.

Sorry Em sửa được lisp của bác rồi. Chạy ok nhưng chỉ có một điều là lâu khủng khiếp. Em dùng có khoảng dưới 100 line mà chạy khoảng 15 phút mới xong. (cấu hình máy: chíp core quad 2,4 - ram 2 6 GB - VGA: geoforce GT 9500). Chưa xoá được các boundary trùng nhau.

[tamkt 2]

Ý của bạn là chia đoạn thẳng thành từng đoạn cho trước hay là chỉ lấy kết quả hiển thị thôi.

 

E chào anh Tú! E chỉ muốn lấy kết quả thôi hà. A giúp e với nha. E cám ơn a.

[phamthanhbinh 3.146]

Sorry Em sửa được lisp của bác rồi. Chạy ok nhưng chỉ có một điều là lâu khủng khiếp. Em dùng có khoảng dưới 100 line mà chạy khoảng 15 phút mới xong. (cấu hình máy: chíp core quad 2,4 - ram 2 6 GB - VGA: geoforce GT 9500). Chưa xoá được các boundary trùng nhau.

Hề hề hề,

Có nhẽ nó lâu là đúng vì mình chơi kiểu củ chuối mà. Cứ theo kinh nghiệm của mình thì cứ chơi 10 lần mỗi lần 10 thằng có khi lại nhanh hơn là chơi một lần 100 thằng bác ạ. Vì càng nhiều thằng càng tăng số bước lặp lên nhiều lần. 10 thằng sẽ có tối đa 45 giao điểm , 10 nhóm có tối đa 450 giao điểm. Còn 100 thằng thì sẽ có tối đa là 4950 điểm giao cắt đó bác ạ. Hề hề hề,....

Mí lại 15 phút mà cho ra được kết quả chuẩn xác cho khoảng 100 thằng line giao cắt nhau thì chắc là cũng nhanh hơn việc làm thủ công kha khá bác nhẩy....

Còn cái vụ xóa các boundary trùng nhau thì mình không làm vì nghĩ rằng chơi cái kiểu của bác "ngược thời gian trở về quá khứ'' cũng hay hay. Hơn nữa cái mục đích cuối cùng của lisp trên chỉ là xuất ra danh sách tọa độ của các boundary chứ chưa phải làm hoàn chỉnh vấn đề mà bác. Các việc còn lại thì ...... nhờ các bác làm nốt, hề hề hề....

[phamngoctukts 714]

E chào anh Tú! E chỉ muốn lấy kết quả thôi hà. A giúp e với nha. E cám ơn a.

Của bạn đây

;; free lisp from cadviet.com
(defun c:dv ()
(setq ent (entget (car (entsel "\nchon doi tuong line")))
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
re (getreal "\nNhap doan chia: ")
di (distance p1 p2)
chia (/ di re)
)
(alert (strcat "line dai: " 
(rtos di) 
"/doan chia: " 
(rtos re) 
" = " 
(rtos chia) 
" phan")
)
)

[phamngoctukts 714]

Hề hề hề,

Có nhẽ nó lâu là đúng vì mình chơi kiểu củ chuối mà. Cứ theo kinh nghiệm của mình thì cứ chơi 10 lần mỗi lần 10 thằng có khi lại nhanh hơn là chơi một lần 100 thằng bác ạ. Vì càng nhiều thằng càng tăng số bước lặp lên nhiều lần. 10 thằng sẽ có tối đa 45 giao điểm , 10 nhóm có tối đa 450 giao điểm. Còn 100 thằng thì sẽ có tối đa là 4950 điểm giao cắt đó bác ạ. Hề hề hề,....

Mí lại 15 phút mà cho ra được kết quả chuẩn xác cho khoảng 100 thằng line giao cắt nhau thì chắc là cũng nhanh hơn việc làm thủ công kha khá bác nhẩy....

Còn cái vụ xóa các boundary trùng nhau thì mình không làm vì nghĩ rằng chơi cái kiểu của bác "ngược thời gian trở về quá khứ'' cũng hay hay. Hơn nữa cái mục đích cuối cùng của lisp trên chỉ là xuất ra danh sách tọa độ của các boundary chứ chưa phải làm hoàn chỉnh vấn đề mà bác. Các việc còn lại thì ...... nhờ các bác làm nốt, hề hề hề....

Bác test thử code trên của em đã hoàn thành rồi đấy. Kết thúc sớm vụ này thôi. Hề hề

[tamkt 2]

Của bạn đây

;; free lisp from cadviet.com
(defun c:dv ()
(setq ent (entget (car (entsel "\nchon doi tuong line")))
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
re (getreal "\nNhap doan chia: ")
di (distance p1 p2)
chia (/ di re)
)
(alert (strcat "line dai: " 
(rtos di) 
"/doan chia: " 
(rtos re) 
" = " 
(rtos chia) 
" phan")
)
)

 

Anh viết như xiếc vậy, hay thật. E cám ơn anh nhiều. Mà e xài líp này thì líp tính diện tích của 1 vùng kín của e bị lỗi, không biết có phải là bị xung đột không nữa, hichic, e gà líp quá. Mong mấy a giúp em với.

 

Nó bị dậy nè , đây là nguyên văn dòng báo:

 

" Command: DTM

CADViet.com © 2007

Vao diem can tinh dien tich: .boundary

Specify internal point or [Advanced options]: A

Enter an option [boundary set/Island detection/Object type]: B

Specify candidate set for boundary [New/Everything] : E Selecting

everything visible...

Analyzing the selected data...

 

Enter an option [boundary set/Island detection/Object type]: I

Do you want island detection? [Yes/No] : Y

Enter an option [boundary set/Island detection/Object type]:

Specify internal point or [Advanced options]:

Valid hatch boundary not found.

Specify internal point or [Advanced options]:

Command: "

 

Đây là lisp diện tích miền, e tải trên Cadviet:

 

"(defun c:dtm()

(defun ctext (diem gt / lst)

(setq lst

(list

(cons 0 "TEXT")

(cons 1 gt)

(cons 10 diem)

(cons 40 (getdist p "\nChieu cao chu: "))

)

)

(entmake lst)

)

(defun dtdoituong (entdt /)

(command ".area" "o" entdt)

(command ".erase" entdt "")

(getvar "area")

)

(defun getbound(p)

(setq ent (entlast))

(command ".boundary" "A" "B" "E" "I" "Y" "" p "")

(setq ent1 (entlast))

(cond

((eq ent ent1) nil)

(t ent1)

)

)

(princ "\nCADViet.com © 2007")

(setq

p (getpoint "\nVao diem can tinh dien tich: ")

entpl (getbound p)

)

(if entpl

(ctext p (rtos (dtdoituong entpl)))

(alert "Diem ban chon khong kin!")

)

(princ)

)

 

(princ "\ndtm - free lisp from www.cadviet.com")

(princ) "

 

Ah, em muốn ghi luôn cả kết quả chia lên bản vẽ như lisp dtm vậy. Anh Tú chỉnh lại giúp e nha. Em cám ơn anh.

[Tue_NV 3.912]

Bác test thử code trên của em đã hoàn thành rồi đấy. Kết thúc sớm vụ này thôi. Hề hề

Chưa kết thúc được đâu bạn ạ

Code của bạn vẫn không chạy được

 

Thank bác đã test giúp. Em đã fix lại rồi.

;; free lisp from cadviet.com

;; 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 "")
(command "erase" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while ((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 ((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))
)
(if (> (sslength list_pl) 1)
(progn
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl))
)
) 
(setq list_plmoi (append (list list_pl) list_plmoi)
)
)
(defun c:tdd ()
(inittdd)
(command "undo" "be")
(setq dlst (list (strcat "X" "\t" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
pw (getpoint "\n Chon goc toa do ")
k 0 id 1
ptlst nil
dlst1 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)
)
(setq ptam (centroid name))
(command "text" "j" "m" ptam "" (rtos id 2 0))
(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))
(alert (strcat "Qua trinh da hoan thanh. Chon duong dan de luu file toa do"))
(setq file (getfiled "chon duong dan de luu file" (getvar "DWGPREFIX") "txt" 1))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(alert (strcat "file da duoc luu tai: " file))
(startapp "notepad" 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 (e / op ptam)
(vl-load-com)
(command "region" e "")
(setq re (entlast))
(setq ob (vlax-ename->vla-object re) 
ptam (vlax-safearray->list (vlax-variant-value (vla-get-Centroid ob)))
)
(command "undo" 1)
ptam
)

Cho Tue_NV rút lại lời góp ý thứ 4 dưới đây và đi theo thuật toán của bác TRUNGNGAMY. Vì rằng Tue_NV post bài trước mới có sự hồi âm của bác TRUNGNGAMY về ý tưởng thuật toán. Chọn 1 loạt đối tượng và xử lý luôn, không chọn theo từng nhóm nữa. Cái nữa, theo Tue_NV được biết là Lisp của bạn chưa đánh số thứ tự tăng dần trong cùng 1 nhóm thửa thì cũng là chưa triệt để lắm. Trong cùng 1 nhóm thửa không nên để các số thứ tự xen lẫn vào nhau. Nên có 1 quy luật đánh số thứ tự nào đó Nếu cứ để như vậy thì trong 1 đa giác lớn, muốn kiểm tra thửa đất nào, tìm trên bản vẽ giấy thì lòi mắt luôn, lại phải mở CAD ra tìm, thật là bất tiện lắm Bài toán này là 1 bài toán lớn, cần có thời gian giải quyết nên chưa thể kết thúc được. Vả lại bạn cũng chưa giải quyết triệt để các vấn đề trên cũng như về mặt tốc độ.......

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

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ý. :cheers:

[phamthanhbinh 3.146]

Anh viết như xiếc vậy, hay thật. E cám ơn anh nhiều. Mà e xài líp này thì líp tính diện tích của 1 vùng kín của e bị lỗi, không biết có phải là bị xung đột không nữa, hichic, e gà líp quá. Mong mấy a giúp em với.

 

Nó bị dậy nè , đây là nguyên văn dòng báo:

 

" Command: DTM

CADViet.com © 2007

Vao diem can tinh dien tich: .boundary

Specify internal point or [Advanced options]: A

Enter an option [boundary set/Island detection/Object type]: B

Specify candidate set for boundary [New/Everything] : E Selecting

everything visible...

Analyzing the selected data...

 

Enter an option [boundary set/Island detection/Object type]: I

Do you want island detection? [Yes/No] : Y

Enter an option [boundary set/Island detection/Object type]:

Specify internal point or [Advanced options]:

Valid hatch boundary not found.

Specify internal point or [Advanced options]:

Command: "

 

Đây là lisp diện tích miền, e tải trên Cadviet:

 

"(defun c:dtm()

(defun ctext (diem gt / lst)

(setq lst

(list

(cons 0 "TEXT")

(cons 1 gt)

(cons 10 diem)

(cons 40 (getdist p "\nChieu cao chu: "))

)

)

(entmake lst)

)

(defun dtdoituong (entdt /)

(command ".area" "o" entdt)

(command ".erase" entdt "")

(getvar "area")

)

(defun getbound(p)

(setq ent (entlast))

(command ".boundary" "A" "B" "E" "I" "Y" "" p "")

(setq ent1 (entlast))

(cond

((eq ent ent1) nil)

(t ent1)

)

)

(princ "\nCADViet.com © 2007")

(setq

p (getpoint "\nVao diem can tinh dien tich: ")

entpl (getbound p)

)

(if entpl

(ctext p (rtos (dtdoituong entpl)))

(alert "Diem ban chon khong kin!")

)

(princ)

)

 

(princ "\ndtm - free lisp from www.cadviet.com")

(princ) "

 

Ah, em muốn ghi luôn cả kết quả chia lên bản vẽ như lisp dtm vậy. Anh Tú chỉnh lại giúp e nha. Em cám ơn anh.

Qua cái thông báo của CAD và nội dung lisp thì thấy nó chả có gì xung đột ở đây cả. Chỉ là cái lisp của bạn chạy chưa chuẩn khi bạn chọn điểm vào một polyline hở mà thôi. Bạn hãy thử lại xem.

[phamngoctukts 714]

Anh viết như xiếc vậy, hay thật. E cám ơn anh nhiều.

Ah, em muốn ghi luôn cả kết quả chia lên bản vẽ như lisp dtm vậy. Anh Tú chỉnh lại giúp e nha. Em cám ơn anh.

Của bạn đây. Hơn cả sự mong đợi.

;; free lisp from cadviet.com
(defun c:dv ()
(setq ent (entget (car (entsel "\nchon doi tuong line L:")))
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent)))
(if (> (car p1) (car p2)) 
(progn
(setq p2 (cdr (assoc 10 ent))
p1 (cdr (assoc 11 ent)))
)
)
(setq re (getreal "\nNhap doan chia DC: ")
caochu (getreal "\nNhap cao chu: ")
di (distance p1 p2)
chia (/ di re)
td (polar p1 (angle p1 p2) (/ di 2))
dc (polar td (+ (angle p1 p2) (/ pi 2)) caochu)
ghichu (strcat "L" (rtos di) "/DC" (rtos re) "=" (rtos chia) "PHÇN")
)
(ctext dc ghichu caochu (angle p1 p2))
)

(defun ctext (diem gt cc goc /)
(setq lst
(list
(cons 0 "TEXT")
(cons 1 gt)
(cons 10 diem)
(cons 40 cc)
(cons 50 goc)
)
)
(entmake lst)
(setq e (entget (entlast)))
(setq e (entmod (subst (cons 72 1) (cons 72 0) e)))
(entmod (subst (cons 11 dc) (assoc 11 e) e))
)

[phamthanhbinh 3.146]

Bác test thử code trên của em đã hoàn thành rồi đấy. Kết thúc sớm vụ này thôi. Hề hề

Chào bác Phamngoctukts,

Mình đã test cái lisp của bác trên cái file của bạn hdt và nhận được kết quả như sau:

http://www.cadviet.com/upfiles/3/tu1.jpg

Kết quả này không rõ bạn hdt4151 có hài lòng hay không nhưng mình thấy nó khác với cái của mình một số điểm như sau:

1/- Trong lisp của bác đã có đoạn xuất text ra file nằm cùng thư mục với bản vễ nhưng không hiểu sao mình tìm không thấy nó đâu cả để kiểm tra.

2/- Bác đã xóa các line và chỉ còn lại các boundary đơn

3/- Có một dòng text Region trong một boundary duy nhất, các boundary khác không có text.

4/- Khi lisp dừng chạy, nếu nhấn tiếp enter thì xuất hiện thông báo Xảy ra lỗi trong quá trình thao tác mà mình chưa biết thao tac sai chỗ nào bác ạ.

 

Và như vậy thì cái yêu cầu xác định boundary tương ứng với các text xuất ra có nhẽ sẽ có trục trặc bác ạ.

Cả cái việc xác định các điểm nằm trên boundary có nhẽ bác cũng chưa giải quyết thì phải.

 

Về tốc độ thì với cùng bản vẽ của bạn hdt4151, lisp của bác cho kết quả nhanh hơn lisp của mình mặc dầu mình chưa test được là nhanh hơn bao nhiêu lần bác ạ.

 

Hy vọng bác sẽ sớm hoàn thiện được cái lisp này.