Đế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

#2181 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 October 2010 - 10:56 AM

Nói chung cách của bạn phamngoctukts làm mất đối tuợng gốc ban đầu.
(có thể bạn sẽ khắc phục bằng cách Copy ra file mới, nhưng việc này đòi hỏi nhiều thời gian)
......

Bạn Tú dùng "chiêu" "Ngược thời gian, trở về quá khứ, phút giây..." anh ạ :cheers:
thể hiện ở chổ này :
(defun c:tdd ()
(command "undo" "be")
.....
......
(command "undo" "e")
(command "undo" "")
Nếu dùng cái này, bạn phải bẫy lỗi, kẻo không User nhấn ESC giữa chừng thì hỏng hết
Tue_NV có góp ý như thế này :
1. Trong bản vẽ có nhiều đối tượng cần tạo Region và xuất tọa độ.
Khi xử lý với 1 nhóm đối tượng thôi thì Lisp xử lý toàn bộ các nhóm luôn. Tue_nv nghĩ là không nên vì làm chậm quá trình tính toán. Chọn 1 nhóm mà xử lý luôn cả nhóm thì chưa ổn lắm bạn ạ.
2. Nói về tốc độ, quả thật Lisp làm việc rất chậm, thao tác qua quá nhiều vòng lặp, Bạn cứ thử bản vẽ với khoảng hơn 100 đối tượng thì tốc độ chậm lắm. Nhiều nữa, e là đứng máy luôn
3. Về kết quả xuất thì nên sử dụng hàm getfiled là hay nhất. Vì có thể User muốn xuất sang các file khác nhau
4. Việc xử lý các nhóm khác nhau, có thể xử dụng phuơng án này :
--- Chọn đối tượng độc lập theo từng nhóm -> Cho vào 1 List. Duyệt qua tập chọn trong List đó và xử lý. Xem ra, hoàn thành được Lisp này phải tốn rất nhiều thời gian quá, bạn nhỉ? :cheers:
  • 0

#2182 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 11 October 2010 - 11:16 AM

Bạn Tú dùng "chiêu" "Ngược thời gian, trở về quá khứ, phút giây..." anh ạ :cheers:
thể hiện ở chổ này :
(defun c:tdd ()
(command "undo" "be")
.....
......
(command "undo" "e")
(command "undo" "")
Nếu dùng cái này, bạn phải bẫy lỗi, kẻo không User nhấn ESC giữa chừng thì hỏng hết

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

Tue_NV có góp ý như thế này :
1. Trong bản vẽ có nhiều đối tượng cần tạo Region và xuất tọa độ.
Khi xử lý với 1 nhóm đối tượng thôi thì Lisp xử lý toàn bộ các nhóm luôn. Tue_nv nghĩ là không nên vì làm chậm quá trình tính toán. Chọn 1 nhóm mà xử lý luôn cả nhóm thì chưa ổn lắm bạn ạ.
2. Nói về tốc độ, quả thật Lisp làm việc rất chậm, thao tác qua quá nhiều vòng lặp, Bạn cứ thử bản vẽ với khoảng hơn 100 đối tượng thì tốc độ chậm lắm
3. Về kết quả xuất thì nên sử dụng hàm getfiled là hay nhất. Vì có thể User muốn xuất sang các file khác nhau
4. Việc xử lý các nhóm khác nhau, có thể xử dụng phuơng án này :
--- Chọn đối tượng độc lập theo từng nhóm -> Cho vào 1 List. Duyệt qua tập chọn trong List đó và xử lý. Xem ra, hoàn thành được Lisp này phải tốn rất nhiều thời gian quá, bạn nhỉ? :cheers:

1. Em chưa hiểu ý này của Bác
2. Về tốc độ thì như em đã nói từ trước (vì non kinh nghiệm nên chưa tối ưu hoá cho lisp được) chủ yếu ở chỗ repeat đầu tiên (chưa biết đwtj điều kiện repeat bao nhiêu là đủ)
3. Do yêu cầu của bạn hdt4151 nên em chỉ xuất sang file txt. Em sẽ nghiên cứu thêm phần này để nhiều người khác còn dùng.
4. Cho em hỏi làm thế nào để chọn đối tượng theo từng nhóm? Giúp đỡ được người khác em thấy vui thời gian không thành vấn đề Bác ạ.
  • 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!

#2183 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 October 2010 - 11:49 AM

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

1. Em chưa hiểu ý này của Bác
2. Về tốc độ thì như em đã nói từ trước (vì non kinh nghiệm nên chưa tối ưu hoá cho lisp được) chủ yếu ở chỗ repeat đầu tiên (chưa biết đwtj điều kiện repeat bao nhiêu là đủ)
3. Do yêu cầu của bạn hdt4151 nên em chỉ xuất sang file txt. Em sẽ nghiên cứu thêm phần này để nhiều người khác còn dùng.
4. Cho em hỏi làm thế nào để chọn đối tượng theo từng nhóm? Giúp đỡ được người khác em thấy vui thời gian không thành vấn đề Bác ạ.

Ý thứ 1 là : Lisp của bạn bao giờ cũng xuất toạ độ của toàn bộ nhóm đối tượng. Trong khi đó, User chỉ muốn xuất chỉ 1 nhóm mà thôi. Mình chỉ chọn 1 nhóm để xử lý mà thôi, bạn à. Vì theo Tue_NV biết là sẽ có các nhóm thửa độc lập với nhau, không liên quan đến nhau.
Ý thứ 2 : Về việc xử lý trong Lisp của bạn, Tue_NV đọc qua thôi, chứ chua lấn sâu vô nhiều, nên không thể đưa ra lời góp ý cho bạn được. Bạn thông cảm. Chỉ có điều là việc xử lý điểm đầu và điểm cuối LINE của bạn rất hay
Ý thứ 3 : Hàm getfiled cho xuất ra hộp thoại và cho phép User lưu ở đâu? cho phép đặt tên khác nhau, và đương nhiên là sẽ lưu file sang .txt hay .xls
Ý thứ 4 :
Bạn có thể tham khảo cái này
(defun c:ndt(/ ss lst);Nhom doi tuong
(setq i 1)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa i)))
(while (setq ss (ssget))
(if ss (setq lst (append lst (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq i (1+ i)))))
)
(alert (strcat "\n Co " (itoa (length lst)) " nhom doi tuong duoc chon" (vl-princ-to-string lst)))
)

  • 1

#2184 hdt4151

hdt4151

    biết vẽ pline

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

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

@bạn Tú: mình đã chạy thử lisp, kết quả đối với 1 nhóm đối tượng ra rất chính xác :cheers:
Phần đầu của lisp có lệnh chọn 1 nhóm đối tượng nhưng khi xuất ra thì xuất ra toàn bộ các nhóm và có hiện tượng thừa đa giác như lúc trước, bạn xem lại lỗi này xem sao nhé ^^
  • 0

#2185 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

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

Ý thứ 1 là : Lisp của bạn bao giờ cũng xuất toạ độ của toàn bộ nhóm đối tượng. Trong khi đó, User chỉ muốn xuất chỉ 1 nhóm mà thôi. Mình chỉ chọn 1 nhóm để xử lý mà thôi, bạn à. Vì theo Tue_NV biết là sẽ có các nhóm thửa độc lập với nhau, không liên quan đến nhau.
Ý thứ 2 : Về việc xử lý trong Lisp của bạn, Tue_NV đọc qua thôi, chứ chua lấn sâu vô nhiều, nên không thể đưa ra lời góp ý cho bạn được. Bạn thông cảm. Chỉ có điều là việc xử lý điểm đầu và điểm cuối LINE của bạn rất hay
Ý thứ 3 : Hàm getfiled cho xuất ra hộp thoại và cho phép User lưu ở đâu? cho phép đặt tên khác nhau, và đương nhiên là sẽ lưu file sang .txt hay .xls
Ý thứ 4 :
Bạn có thể tham khảo cái này

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

Thank bác! từ trước đến nay em cứ nghĩ nhóm selectionset không tạo thành list được.
  • 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!

#2186 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 11 October 2010 - 05:34 PM

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

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

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

#2187 hdt4151

hdt4151

    biết vẽ pline

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

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

@Tue_VN: đúng là hơi khó để kiểm tra với số lượng đa giác lớn, việc ghi số thứ tự của hình vào file cad là cần thiết (lại sinh ra quả trứng khác nữa rồi, cái này để bổ sung sau cùng cũng đc +_+).
1.Ghi số thứ tự vào giữa đa giác, mình không rõ thuật toán pick 1 điểm trong đa giác có khó k, nếu cần thiết có thể kết hợp dùng lisp tính trong tâm (có trong forum).

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

#2188 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 11 October 2010 - 09:43 PM

@bạn Tú: mình đã chạy thử lisp, kết quả đối với 1 nhóm đối tượng ra rất chính xác :cheers:
Phần đầu của lisp có lệnh chọn 1 nhóm đối tượng nhưng khi xuất ra thì xuất ra toàn bộ các nhóm và có hiện tượng thừa đa giác như lúc trước, bạn xem lại lỗi này xem sao nhé ^^

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

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

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

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


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

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

(defun tdderror (errmsg)
(loitdd)
)


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

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

#2189 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 11 October 2010 - 09:49 PM

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

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :
- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)
- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết
- Việc xuất ra file thì đơn giản hơn rồi
  • 2

#2190 phamngoctukts

phamngoctukts

    biết lệnh adcenter

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

Đã gửi 11 October 2010 - 09:56 PM

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :
- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)
- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết
- Việc xuất ra file thì đơn giản hơn rồi

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

#2191 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 11 October 2010 - 10:10 PM

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

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

#2192 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

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

Cám ơn Tue_NV, đúng như bạn nói. Mình nghĩ vđ này có thể giải quyết cách khác như sau :
- Viết hàm xác định điểm trong, ngoài hay trùng cạnh đa giác (kg biết đã có chưa, mình nghĩ dạng hàm này chuẩn chắc đã có ở đâu đó)
- Ta thấy rằng các đa giác bình thường thì không chứa 1 đa giác nào, đa giác bao ngoài chứa ít nhất 2 đa giác bên trong (trừ trường hợp chúng trùng nhau hoàn toàn). Như vậy ta có thể xây dựng thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài, xóa chúng đi và làm lại như thế cho đến hết
- Việc xuất ra file thì đơn giản hơn rồi

Cảm ơn bác TRUNGNGAMY đã đưa ra thuật toán. Bác có thể cho Tue_NV hỏi thêm chổ này được không?
thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài
Nếu có thể, Bác TRUNGNGAMY nói rõ hơn và có thể cho luôn 1 hình ảnh minh hoạ được không?
Cảm ơn bác rất nhiều
  • 0

#2193 pfievxd

pfievxd

    biết vẽ spline

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

Đã gửi 11 October 2010 - 11:21 PM

Em có 2 bài toán thế này nhé :
Bài toán 1:
Có n đường thẳng thuộc layer 01 giao với m cung tròn thuộc layer 02
Có sẵn 1 Block hình chữ nhật ( Cho nó dị hướng)
Yêu cầu : chèn Block theo các giao điểm (cái này em có thấy trên diễn đàn rồi) và Trục Block luôn trùng với trục của đường thẳng
Bài toán 2:
Có 3 pline (Hoặc nhiều hơn) thuộc các lớp khác nhau
Yêu cầu : Xác định đa giác khép kín tạo bởi các pline bằng cách hatch vào đa giác đó xong roài tính dt vùng hatch đó luôn thì càng tốt
Em học lisP được một tuần roài, bắt đầu biết sơ sơ, các bác cao thủ rảnh rỗi thì giúp em với, không thì định hướng cho em cái thuật toán cũng là quá tốt. Thanks các bác nhiều :cheers:
  • 0

#2194 hdt4151

hdt4151

    biết vẽ pline

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

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

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

#2195 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 - 12:24 AM

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

không down được bạn ơ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!

#2196 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 - 12:44 AM

Cảm ơn bác TRUNGNGAMY đã đưa ra thuật toán. Bác có thể cho Tue_NV hỏi thêm chổ này được không?
thuật toán duyệt qua từng đa giác, tại mỗi đa giác duyệt qua trung điểm tất cả các cạnh tạo nên tập hợp đa giác trên, nếu tồn tại chỉ một trung điểm nắm trong đa giác đang xét thì đó là 1 đa giác bao ngoài
Nếu có thể, Bác TRUNGNGAMY nói rõ hơn và có thể cho luôn 1 hình ảnh minh hoạ được không?
Cảm ơn bác rất nhiều

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

#2197 hdt4151

hdt4151

    biết vẽ pline

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

Đã gửi 12 October 2010 - 12:45 AM

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

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

#2198 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 - 08:27 AM

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

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

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

#2199 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 - 08:40 AM

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

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

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

;; free lisp from cadviet.com


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

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

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


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

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

(defun tdderror (errmsg)
(loitdd)
)


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

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

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

#2200 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

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

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


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

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

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

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

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

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

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 TRUNGNGAMY : Cảm ơn bác rất nhiều. Thuật toán rất hay :cheers:
  • 0