Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
15 replies to this topic

#1 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 09:35 AM

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


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 30 October 2013 - 09:46 AM

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 à?


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2013 - 09:46 AM

Cơ bản là code bạn sai ở đây :

(setq a (list (558911.0 2.37805e+006 130.0)


  • 0

#4 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 09:54 AM

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?


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#5 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 09:55 AM

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.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#6 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2013 - 10:05 AM

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


  • 1

#7 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 10:08 AM

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.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#8 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2013 - 10:16 AM

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


  • 0

#9 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 10:17 AM

Nhưng của mình kết quả vẫn 71 mà. -> lisp không chạy

???????


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#10 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 10:21 AM

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


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#11 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2013 - 10:23 AM

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


  • 1

#12 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 10:26 AM

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.


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#13 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5451 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 30 October 2013 - 10:26 AM

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?

Cám ơn bạn rất nhiều! ^_^


  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#14 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 10:52 AM

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.c...new_block_1.dwg

http://www.cadviet.c...ong_gian1_1.lsp


  • -1
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.

#15 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 30 October 2013 - 11:16 AM

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.c...new_block_1.dwg

http://www.cadviet.c...ong_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.


  • 0

#16 18011985

18011985

    biết lệnh properties

  • Members
  • PipPipPipPip
  • 255 Bài viết
Điểm đánh giá: 61 (tàm tạm)

Đã gửi 30 October 2013 - 11:23 AM

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


  • 0
Trăng 16 trăng tròn
Em 16 bụng ... như trăng

Hướng dẫn sử dụng diễn đàn:
Để cảm ơn hay bài viết có ích: Ấn dấu + cuối bài.
Không vừa lòng hay bài spam: Ấn dấu - cuối bài.