Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

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


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2201 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 12 October 2010 - 09:42 AM

Hề hề. Sao bạn lại lầm lẫn giữa lời góp ý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)))
)
)

  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2202 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 12 October 2010 - 10:26 AM

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

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
  • 0

#2203 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 12 October 2010 - 10:29 AM

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

Hình đã gửi

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.
  • 0

#2204 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 12 October 2010 - 10:52 AM

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

Hình đã gửi

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.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2205 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 12 October 2010 - 12:26 PM

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ề.....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2206 TRUNGNGAMY

TRUNGNGAMY

    biết lệnh block

  • Members
  • PipPipPipPipPipPip
  • 401 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 12 October 2010 - 02:52 PM

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
  • 0

#2207 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 12 October 2010 - 05:20 PM

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.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2208 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 12 October 2010 - 05:26 PM

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.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2209 tamkt

tamkt

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 12 October 2010 - 11:07 PM

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:
  • 0

#2210 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 01:02 AM

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.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2211 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 01:12 AM

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
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2212 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 13 October 2010 - 05:45 AM

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
)

Đã 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 <_<
  • 0

#2213 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 13 October 2010 - 12:16 PM

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 (< 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ề........
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2214 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 02:59 PM

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

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2215 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 04:59 PM

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.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2216 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 07:28 PM

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.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2217 tamkt

tamkt

    biết vẽ ellipse

  • Members
  • PipPip
  • 51 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 13 October 2010 - 09:50 PM

Ý 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.
  • 0

#2218 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 13 October 2010 - 10:22 PM

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ề....
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2219 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 10:22 PM

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

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2220 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 13 October 2010 - 11:37 PM

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ề
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!