Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
18011985

[Sửa lisp]Loại phần tử giống nhau trong list

Các bài được khuyến nghị

18011985    61

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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?

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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

 

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

Còn 5 điểm cuối cùng giống nhau không xử lý được.

 

5 tên cuối: Lisp giữ lại 1 tên rồi bạn....

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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

  • Vote giảm 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
Tue_NV    3.841

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

 

Tình hình là bạn quăng file lên mà không mô tả cái gì cả thì tôi cũng chịu rồi

Không phải ai cũng như bạn để hiểu được cái điều bạn muốn.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
18011985    61

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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×