18011985
-
Số lượng nội dung
259 -
Đã tham gia
-
Lần ghé thăm cuối
-
Ngày trúng
3
Bài đăng được đăng bởi 18011985
-
-
Cảm ơn các bài trao đổi của các bác. Các bác test giúp em nhé. Lệnh Vla-delete cad2012 không thực hiện được các bác sửa dùm em.
(defun c:tt (/ i item lst obj pt) (vl-load-com) (setq i 0) (while (setq pt (getpoint "\nChon diem:")) (cond ((= i 0) (progn (vl-cmdf "-boundary" "a" "o" "r" "" pt "") (setq obj (vlax-ename->vla-object (entlast))) (setq item (cons (vlax-get obj 'Centroid) (vlax-get obj 'Area))) ;(vla-delete obj) (setq lst (cons item lst)) ) ) ((/= i 0) (progn (vl-cmdf "-boundary" "a" "o" "r" "" pt "") (setq obj (vlax-ename->vla-object (entlast))) (setq item (cons (vlax-get obj 'Centroid) (vlax-get obj 'Area))) (if (/=(member item lst)nil) (alert "trung roi...") (setq lst (cons item lst))) ;(vla-delete obj) ) ) ) (setq i (1+ i)) ) lst)
-
Cảm ơn các bác chủ TP đang test nhưng chưa thấy ổn nên chưa ý kiến ạ.
-
Mình viết đoạn code để lọc hình pick trùng nhưng thỉnh thoảng vẫn trả kết quả sai. Mong các bạn góp ý chỉnh sửa
(defun c:ax (/ I a1 FOD KT dtlist tglist k) (defun kiemtra (z1 z2 z3 / i itest atest ctest) (setq i 0) (setq itest (-(length z2)1)) (while (<= i itest) (setq atest (vlax-get z1 'Area)) (setq ctest (vlax-get z1 'Centroid)) (if (and (equal atest (nth i z2)0.0001) (equal (car ctest) (car (nth i z3))0.0001) (equal (cadr ctest) (cadr (nth i z3)))0.0001) (progn (setq k 1) (setq i (+ itest 1)) ) (progn (setq k 0) ) ) (setq i (+ i 1)) (Setq atest nil) (Setq ctest nil) ) (if (= k 1) (alert "trung roi") (alert "ok")) );end kiem tra (setq i 0) (setq k 0) (while (setq a1 (getpoint "\n Chon diem:" )) (if (eq i 0) (progn (command "-boundary" "a" "o" "r" "" a1 "") (setq FOD (vlax-ename->vla-object (entlast))) (setq dtlist (append dtlist (list (vlax-get FOD 'Area)))) (setq tglist (append tglist (list (vlax-get FOD 'Centroid)))) (command "erase" (entlast) "") );end progn (progn (command "-boundary" "a" "o" "r" "" a1 "") (setq KT (vlax-ename->vla-object (entlast))) (kiemtra KT dtlist tglist) (if (= k 0) (progn (setq dtlist (append dtlist (list(vlax-get KT 'Area)))) (setq tglist (append tglist (list(vlax-get KT 'Centroid)))) ) ) (command "erase" (entlast) "") ;(setq i (+ i 1)) );end progn );end if (setq i (+ i 1)) );end while (princ dtlist) ); end defun ;;;;
-
Mình đã đọc các lisp pick diện tích trên diễn đàn và các lisp có 1 khuyết điểm không lọc được hình pick trùng.
Các bạn giúp mình lisp pick diện tích sử dụng boundary (region) và có lọc các hình pick trùng.
- Có 3 hình pick diện tích. Sau khi pick 3 hình thì mình pick lại 1 hình nào đó thì mình muốn CAD báo hình đã pick và không tính diện tích hình bị trùng đấy.
Rất mong các bạn giúp đỡ!
-
Cảm ơn bạn đã giúp đỡ. Mình có cách khác là copy tất cả đối tượng từ bản vẽ Block hỏng sang bản vẽ block không hỏng là ok.
Nhưng có các bất cập:
- Chỉnh lại toàn bộ layout
- Mất các đối tượng ẩn
Mình đã thử cách xoá hết block đó sau đó purge nhưng không ăn thua. Copy lại vẫn bị như vậy.
Bạn xem có cách khác không. Nó có phải do biến hệ thống không.
-
Cảm ơn bạn. Nhưng còn 1 lỗi nữa bạn à, bạn giúp mình nhé. Mình copy mốc sang chỉ hiện mỗi số thôi các nét mất hết.
-
Mình có 2 bản vẽ. Khi copy block ở bản vẽ này sang bản vẽ kia thì bị thiếu đi một số đối tượng. Mong các bạn chỉ dùm
Sau đây là 2 bản vẽ của mình
-
Cảm ơn bạn nhiều mọi thứ đúng như vậy.
-
Cảm ơn bạn mình đã test nhưng ......... với ít đường đồng mức thì đúng, càng nhiều đường đồng mức thì lại sai một số điểm.
Bạn test lại hộ mình với bản vẽ này nhé.
-
Mình đã tìm hiểu ở bản vẽ sai, khi đưa các đối tượng về gần WCS 0,0,0 thì lại cho kết quả đúng.
Các bạn chỉ giúp mình làm thế nào đê vẫn giữ nguyên tọa độ ban đầu mà vẫn cho kết quả đúng không?
-
Mình test đúng trên bản vẽ đó. Nhưng mặt cắt không đúng với thực tế là cao trình đỉnh giữa của pline phải cao hơn (hoặc thấp hơn) cao trình đường đồng mức trong cùng. Bạn phải thêm bằng thủ công hoặc vẽ thêm 1 pline cao trình lẻ qua đỉnh đó
Vấn đề không nằm ở đó bạn à. mình post ở đây bạn xem nhé
http://www.cadviet.com/forum/topic/85502-nho-giup-do-lisp-tim-giao-diem/
-
Sau khi nhận được sự giúp đỡ từ các bạn trên diễn đàn mình đã chỉnh sửa và hoàn thành lisp tìm giao điểm.
Nhưng trong quá trình test lisp mình gặp phải rắc rối sau.
Cùng 1 tập hợp đối tượng nhưng ở 2 bản vẽ khác nhau cho 2 kết quả khác nhau.
Vậy chứng tỏ lisp không cho kết quả sai mà định dạng của 2 file bản vẽ có vấn đề. Các bạn có thể chỉ ra hộ mình không?
Mình không dành về biến định dạng của file lắm.
Bản vẽ cho kết quả đúng:http://www.cadviet.com/upfiles/3/10633_test1_1.dwg
Bản vẽ cho kết quả sai:http://www.cadviet.com/upfiles/3/10633_dongmuc_1.dwg
(defun c:tt (/ E1 E2 ELE ELE1 PLST PST SSL)
;;;;----------------------------Relist------------------------------
(defun relist (lst / lst1)
;;;writen by Tue_NV
(foreach x lst
(if (not (member x lst1)) (setq lst1 (append lst1 (list x))))
(Progn
(foreach y lst1
(if (equal y x 1.0e-8)
(setq lst1 (vl-remove y lst1))
);end if
);end Foreach
(setq lst1 (append lst1 (list x)))
);end progn
);end Foreach
)
;;;;;-------------------------Chay chuong trinh----------------------
(princ "\n Chon duong dong muc: ")
(setq ssl (acet-ss-to-list (ssget))
plst (list)
e2 (car (entsel "\n Chon duong tim")))
;;;;--------------------------Tim giao diem khong gian------------------------
(foreach en ssl
(cond
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (setq ele (cdr (assoc 38 (entget en)))))
((= (cdr (assoc 0 (entget en))) "POLYLINE")(setq ele (last (cdr (assoc 10 (entget en))))))
((= (cdr (assoc 0 (entget en))) "LINE") (setq ele (last (cdr (assoc 10 (entget en))))))
((= (cdr (assoc 0 (entget en))) "TEXT") (progn (setq ele 0)(setq ele1 (cdr (assoc 10 (entget en))))))
(T (setq ele nil))
)
(if ele
(progn
(if (= ele 0)
(progn
(setq plst (append plst (list ele1)))
)
(progn
(command "copy" e2 "" (list 0 0 0) (list 0 0 ele))
(setq e1 (entlast)
plst (append plst (acet-geom-intersectwith e1 en 0)) )
(command "erase" e1 "")
)
)
)
)
)
;;;;;;;-----------------------------Sap xep va xoa diem trung--------------------------
(setq plst (relist plst))
(if(= (cdr(assoc 0 (entget e2))) "LINE")
(progn
(setq pst (vlax-curve-getStartPoint e2))
(setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))
)
(progn
(setq plst (vl-sort plst '(lambda (x y) (< (vlax-curve-getparamatpoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getparamatpoint e2 (list (car y) (cadr y) 0))))))
)
)
(princ plst)
(princ)
) -
Tách thành 2 trường hợp
(if (= (cdr (assoc 0 (entget e2))) "LINE") (progn (setq pst (vlax-curve-getStartPoint e2)) (setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0)))))) ) (setq plst (vl-sort plst '(lambda (x y) (< (vlax-curve-getparamatpoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getparamatpoint e2 (list (car y) (cadr y) 0)))))))
mình cũng đã tách. Nhưng với bản vẽ #7 thì không cho kết quả đúng. Bạn có thể xem lại giúp mình không?
Mình thử bản vẽ mới thì tất cả ok. Nhưng với bản vẽ mình up lên ở #7 thì không đúng. Bạn có thể nói cho mình vì sao nó lại sai lệch không.
-
Hàm vlax-curve-getparamatpoint sẽ cho kết quả sai đối với LINE, vì vậy bạn dùng đường tìm giao điểm là pline hoặc dùng đoạn code sau thay cho
(setq plst (vl-sort plst .....
(setq pst (vlax-curve-getStartPoint e2)) (setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))
Code bạn viết dùng (car vtmc) (cadr vtmc) rất nhiều chỗ, nên đặt biến trung gian VD: xo, yo
(+ (carvtmc) -30) => x1
(+ (car vtmc) -31) => x2
Dùng hàm atoi thay vì atof đối với số nguyên
(rtos (setq moc0 (+ moc0 1)) 2 0) => (atoi (setq moc0 (1+ moc0)))
Trong trường hợp như hình vẽ thì hàm của bạn chưa đúng bạn có thể sửa giúp mình không, mình đã nghĩ ra 1 hàm nhưng kết quả vẫn sai.
http://www.cadviet.com/upfiles/3/10633_dongmuc.dwg
(setq plst (vl-sort plst '(lambda (x y) (< (vlax-curve-getDistAtPoint e2 (list (car x) (cadr x) 0)) (vlax-curve-getDistAtPoint e2 (list (car y) (cadr y) 0))))))
-
ops sorry bác.
Để em ngăt phần không liên quan.
(defun c:tt (/ E1 E2 ELE ELE1 PLST PST SSL)
;;;;----------------------------Relist------------------------------
(defun relist (lst / lst1)
;;;writen by Tue_NV
(foreach x lst
(if (not (member x lst1)) (setq lst1 (append lst1 (list x))))
(Progn
(foreach y lst1
(if (equal y x 1.0e-8)
(setq lst1 (vl-remove y lst1))
);end if
);end Foreach
(setq lst1 (append lst1 (list x)))
);end progn
);end Foreach
)
;;;;;-------------------------Chay chuong trinh----------------------
(princ "\n Chon duong dong muc: ")
(setq ssl (acet-ss-to-list (ssget))
plst (list)
e2 (car (entsel "\n Chon duong tim")))
;;;;--------------------------Tim giao diem khong gian------------------------
(foreach en ssl
(cond
((= (cdr (assoc 0 (entget en))) "LWPOLYLINE") (setq ele (cdr (assoc 38 (entget en)))))
((= (cdr (assoc 0 (entget en))) "POLYLINE")(setq ele (last (cdr (assoc 10 (entget en))))))
((= (cdr (assoc 0 (entget en))) "LINE") (setq ele (last (cdr (assoc 10 (entget en))))))
((= (cdr (assoc 0 (entget en))) "TEXT") (progn (setq ele 0)(setq ele1 (cdr (assoc 10 (entget en))))))
(T (setq ele nil))
)
(if ele
(progn
(if (= ele 0)
(progn
(setq plst (append plst (list ele1)))
)
(progn
(command "copy" e2 "" (list 0 0 0) (list 0 0 ele))
(setq e1 (entlast)
plst (append plst (acet-geom-intersectwith e1 en 0)) )
(command "erase" e1 "")
)
)
)
)
)
;;;;;;;-----------------------------Sap xep va xoa diem trung--------------------------
(setq plst (relist plst))
(setq pst (vlax-curve-getStartPoint e2))
(setq plst (vl-sort plst '(lambda (x y) (< (distance pst (list (car x) (cadr x) 0)) (distance pst (list (car y) (cadr y) 0))))))
)Bác xem giúp hộ em nhé.
-
TÌnh hình là vẫn chưa ổn bác TUE_VN ạ.
Khi đưa đoạn code vào lisp thì xảy ra lỗi xem chi tiết file kèm theo, bác chỉ giúp em vì sao lại còn xót như vậy. cảm ơn bác.http://www.cadviet.com/upfiles/3/10633_new_block_1.dwg
http://www.cadviet.com/upfiles/3/10633_tim_gd_khong_gian1_1.lsp
-
1
-
-
Bạn tìm trong lisp của bạn post bài đầu.
1./ setq lại biến a
2./ tìm chữ (princ a) -> xoa đi
3./ Thay (relist a) thành (setq c (relist a))
4./ Chạy Lisp -> kiểm tra lại biến c
Hì nông dân quá quên mất chưa setq lại biến a. Cảm ơn Bác.
-
Bạn up code lên được không cũng vói code mình up lên kết quả vẫn 71 mình không hiểu
-
Nhưng của mình kết quả vẫn 71 mà. -> lisp không chạy
???????
-
Mình chạy thì thấy đã loại bỏ rồi bạn.
(length a)-> 71
Sau khi chạy (setq b (length a)) -> 61
10 phần tử được loại.
Test các phần tử giống nhau thì lisp chạy đúng
Còn 5 điểm cuối cùng giống nhau không xử lý được.
-
Cơ bản là code bạn sai ở đây :
(setq a (list (558911.0 2.37805e+006 130.0)
ĐÚng là sai ở chỗ đó nhưng thay thành (setq a '((558911.0 2.37805e+006 130.0) .... chạy nhưng các phần tử giống nhau không bị loại bỏ.
Bác xem giúp em.
-
Tôi có gởi tin nhắn cho bạn 1 hàm loại các phần tử "gần bằng nhau". Bạn không sử dụng được à?
Mình có dùng nhưng không cho ra kết quả. Bạn có thể add vào lisp này không?
-
Mình đang cần loại bỏ phần tử giống nhau trong 1 biến list. Nhưng không được. Mình tìm trên Diễn đàn có của bác TUEVN nhưng up vào lisp không làm được. Các bác sửa giúp em.
(defun c:tes (/ a)
(setq a '((558911.0 2.37805e+006 130.0) (558906.0 2.37805e+006 129.0) (558902.0 2.37805e+006 128.0) (558899.0 2.37804e+006 127.0) (558896.0 2.37804e+006 126.0) (558894.0 2.37804e+006 125.0) (558892.0 2.37804e+006 124.0) (558890.0 2.37804e+006 123.0) (558887.0 2.37804e+006 122.0) (558885.0 2.37804e+006 121.0) (558883.0 2.37804e+006 120.0) (558881.0 2.37804e+006 119.0) (558878.0 2.37804e+006 118.0) (558875.0 2.37803e+006 117.0) (558872.0 2.37803e+006 116.0) (558872.0 2.37803e+006 116.0) (558870.0 2.37803e+006 115.0) (558869.0 2.37803e+006 114.0) (558867.0 2.37803e+006 113.0) (558865.0 2.37803e+006 112.0) (558863.0 2.37803e+006 111.0) (558862.0 2.37803e+006 110.0) (558862.0 2.37803e+006 110.0) (558860.0 2.37803e+006 109.0) (558858.0 2.37803e+006 108.0) (558857.0 2.37803e+006 107.0) (558855.0 2.37803e+006 106.0) (558853.0 2.37803e+006 105.0) (558852.0 2.37803e+006 104.0) (558850.0 2.37803e+006 103.0) (558849.0 2.37802e+006 102.0) (558847.0 2.37802e+006 101.0) (558845.0 2.37802e+006 100.0) (558843.0 2.37802e+006 99.0) (558842.0 2.37802e+006 98.0) (558840.0 2.37802e+006 97.0) (558838.0 2.37802e+006 96.0) (558836.0 2.37802e+006 95.0) (558834.0 2.37802e+006 94.0) (558832.0 2.37802e+006 93.0) (558830.0 2.37802e+006 92.0) (558828.0 2.37802e+006 91.0) (558826.0 2.37802e+006 90.0) (558824.0 2.37801e+006 89.0) (558823.0 2.37801e+006 88.0) (558821.0 2.37801e+006 87.0) (558819.0 2.37801e+006 86.0) (558817.0 2.37801e+006 85.0) (558815.0 2.37801e+006 84.0) (558813.0 2.37801e+006 83.0) (558813.0 2.37801e+006 83.0) (558812.0 2.37801e+006 82.0) (558810.0 2.37801e+006 81.0) (558810.0 2.37801e+006 81.0) (558810.0 2.37801e+006 81.0) (558810.0 2.37801e+006 81.0) (558808.0 2.37801e+006 80.0) (558806.0 2.37801e+006 79.0) (558804.0 2.37801e+006 78.0) (558802.0 2.37801e+006 77.0) (558800.0 2.37801e+006 76.0) (558798.0 2.378e+006 75.0) (558796.0 2.378e+006 74.0) (558795.0 2.378e+006 73.0) (558793.0 2.378e+006 72.0) (558789.0 2.378e+006 71.0) (558784.0 2.378e+006 70.0) (558784.0 2.378e+006 70.0) (558784.0 2.378e+006 70.0) (558784.0 2.378e+006 70.0) (558784.0 2.378e+006 70.0)))
(defun relist (lst / lst1)
;;;writen by Tue_NV
(foreach x lst
(if (not (member x lst1)) (setq lst1 (append lst1 (list x))))
(Progn
(foreach y lst1
(if (equal y x 1.0e-8)
(setq lst1 (vl-remove y lst1))
)
)
(setq lst1 (append lst1 (list x)) )
)
)
lst1
)
(relist a)
(princ a)
(princ)
) -
Quên mất các bạn giúp mình trong trường hợp các đường đồng mức trùng nhau thì plst phải xử lý thế nào để không có toạ độ trùng.
[Yêu Cầu] Lisp Tính Diện Tích (Có Lọc Hình Pick Trùng)
trong AutoLisp
Đã đăng · Trả lời báo cáo
Lâu ngày không viết lisp nên hơi ngu ý. Bác Doan Van Ha nói đúng ý em rùi. Bác có thể viết đoạn ví dụ khi xét ename hoặc Handle của entity không ạ.