Đến nội dung


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

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)


  • Please log in to reply
2848 replies to this topic

#1841 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 September 2014 - 09:26 AM

Theo cái #1834 thì không xóa, còn #1838 của bạn sửa lại thì tôi không biết.

Điều kiện của tôi ko liên quan gì đến khoảng cách cả, chỉ liên quan tới góc thôi.


  • 0

#1842 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 September 2014 - 09:56 AM

Theo cái #1834 thì không xóa, còn #1838 của bạn sửa lại thì tôi không biết.

Điều kiện của tôi ko liên quan gì đến khoảng cách cả, chỉ liên quan tới góc thôi.

 

Đúng là cái lsp của bác ở bài  #1834 chưa triệt để

File test đây bác:

http://www.cadviet.c...4652_test00.dwg


  • 0

#1843 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 09:59 AM

(defun c:XLT( / ss Lts_EnameLine Lts_KC_Ename Lts_KC_Ename_Sort Lts_Ename Lts_Line_OK  );;;XOA LINE TRUNG
(setvar "CMDECHO" 0)
(setq ss (ssget (list (cons 0 "LINE"))))
(setq Lts_EnameLine (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "LINE") x nil)) (acet-ss-to-list ss))))
(setq Lts_KC_Ename (mapcar '(lambda (x) (cons (distance (acet-dxf 10 (entget x)) (acet-dxf 11 (entget x))) x)) Lts_EnameLine))
(setq Lts_KC_Ename_Sort (vl-sort Lts_KC_Ename '(lambda(e1 e2) (> (car e1) (car e2)))))
(setq Lts_Ename (mapcar '(lambda (x) (cdr x)) Lts_KC_Ename_Sort))
(setq Lts_Line_OK (TD:Remove-Obj-duplicates Lts_Ename))
(alert "Xong!")
(princ)
)

(defun GetPnt (Ma x  /)
(acet-dxf Ma (entget x))
)

(defun GetLineDup (lst / lst1)
(setq lst1 (list (car lst)))
(while lst
	(setq lst (cdr lst)
		x (last lst1))
	(foreach y lst
		(if (and
		      (equal (+ (distance (GetPnt 10 x) (GetPnt 10 y)) (distance (GetPnt 10 y) (GetPnt 11 x))) (distance (GetPnt 10 x) (GetPnt 11 x)) 0.000001)
		      (equal (+ (distance (GetPnt 10 x) (GetPnt 11 y)) (distance (GetPnt 11 y) (GetPnt 11 x))) (distance (GetPnt 10 x) (GetPnt 11 x)) 0.000001)
		    )
		(setq lst (vl-remove y lst))
		)
	)
	(setq lst1 (append lst1 (list (car lst))))
)
)

(defun LM:ListDifference ( l1 l2 )
  (vl-remove-if '(lambda ( x ) (member x l2)) l1)
)


(defun LM:RemoveOnce ( l1 l2 )
  (if l1
    (if (equal (car l1) l2)
      (LM:RemoveOnce (cdr l1) l2)
      (cons (car l1) (LM:RemoveOnce (cdr l1) l2))
    )
  )
)

(defun TD:Remove-Obj-duplicates (ss_list /  Lts1 Lts2 )
(vl-load-com)
(setq Lts1  (GetLineDup ss_list ))
(setq Lts2 (LM:ListDifference ss_list Lts1))
(setq Lts3 (LM:RemoveOnce Lts1 ss_list))
(foreach e Lts2
	(entdel e)
)
Lts3
)

Cái này thì ổn rồi anh ạ. Hii


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1844 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 10:04 AM

File test của anh Tue_NV thì ko đúng điều kiện nên nó ko xóa.

Điều kiện chỉ là các đoạn thẳng nằm trong khoảng line dài nhất thôi ạ. vắt chéo nhau thì ko xóa anh ạ.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1845 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 September 2014 - 10:06 AM

Em xem có mấy cái Line ngắn (A) trong đoạn Line dài đó em. 

Đúng ra Line ngắn (A) phải xóa => Cái Lsp của em cũng chưa triệt để 


  • 0

#1846 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 10:10 AM

Như vậy là điều kiện vẫn còn thiếu phải không anh?


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1847 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 September 2014 - 10:44 AM

Bạn thử cái này xem.

(defun GetLineDup (lst / lst1)
  (setq lst1 (list (car lst)))
  (while lst
    (setq lst (cdr lst)
 x (last lst1))
    (foreach y lst
      (if (and (equal 0 (distance (GetPnt 10 y)
(vlax-curve-getClosestPointto x (GetPnt 10 y))) 0.00001)
          (equal 0 (distance (GetPnt 11 y)
(vlax-curve-getClosestPointto x (GetPnt 11 y))) 0.00001)
)
(setq lst (vl-remove y lst))
      )
    )
    (setq lst1 (append lst1 (list (car lst))))
  )
)

  • 1

#1848 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 September 2014 - 10:48 AM

Bạn thử cái này xem.

 

(defun GetLineDup (lst / lst1)
  (setq lst1 (list (car lst)))
  (while lst
    (setq lst (cdr lst)
 x (last lst1))
    (foreach y lst
      (if (and (equal 0 (distance (GetPnt 10 y)
(vlax-curve-getClosestPointto x (GetPnt 10 y))) 0.00001)
          (equal 0 (distance (GetPnt 11 y)
(vlax-curve-getClosestPointto x (GetPnt 11 y))) 0.00001)
)
(setq lst (vl-remove y lst))
      )
    )
    (setq lst1 (append lst1 (list (car lst))))
  )
)

 

Với file test đã gửi của mình thì nó vẫn "u như kỹ" ^_^ (Chưa triệt để) ^_^


  • 0

#1849 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 10:51 AM

Em đi nấu cơm đã, tí về em test. Cảm ơn 2 anh.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1850 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 14 September 2014 - 10:56 AM

Với file test đã gửi của mình thì nó vẫn "u như kỹ" ^_^ (Chưa triệt để) ^_^

Nhìn xa thì thấy trùng, nhìn gần thì cách nhau 1 khúc <_<  <_<

Ủa mà sao lại dùng polyline? đang nói tới Line mà? Bác Tue chơi khăm quá!! 


  • 1

#1851 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 14 September 2014 - 11:12 AM

Nhìn xa thì thấy trùng, nhìn gần thì cách nhau 1 khúc <_<  <_<

Ủa mà sao lại dùng polyline? đang nói tới Line mà? Bác Tue chơi khăm quá!! 

 

Ồ! Sorry bác! Mình test nhầm cái Line dài bằng Pline.

Thanks


  • 0

#1852 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 11:36 AM

@@. Em vội quá nên ko để ý. :D
Vậy là ok rồi. :D


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1853 dunghn

dunghn

    biết vẽ ellipse

  • Members
  • PipPip
  • 57 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 14 September 2014 - 12:34 PM

Gửi vào Hôm nay, 12:27 PM

Đưa yêu cầu vào đây là nhầm chỗ, mong các bác đại xá (Vì e vào chỗ viết Lisp theo yêu cầu kg được - Kg biết tại sao). Có một việc muốn nhờ các bác giúp hộ. Tôi muốn dùng một lisp xuất thông số chiều dài các đường line sang excel, các đường line chọn bằng phương pháp quét cửa sổ chứ không kích chọn từng line. Trên diễn đàn tôi thấy có lisp của bác PhamThanhBinh: 5194_ghisolieuchieudai.lsp nhưng không thể tải về được, có lisp BTK.lsp nhưng phải kich chọn từng line và có cả phần xuất ra bảng in trong CAD nên tôi không ưng ý lắm. Dùng lệnh Dataextraction thì lại lâu quá. Bác nào có lòng tốt cho tôi 1 lisp để xuất thẳng dữ liệu (Chỉ cần chiều dài) sang excel hoặc up lại cho tôi  lisp 5194_ghisolieuchieudai.lsp của bác PhamThanhBinh cũng quá được. Xin cảm ơn các bác nhiều   :)

  • 0

  • 0

#1854 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 14 September 2014 - 02:44 PM

Sự tham lam lười biếng


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


#1855 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 03:14 PM

Cảm ơn các bác đã giúp đỡ. 

Em đã học được rất nhiều thứ từ kiến thức rỗng.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1856 phamhuy1

phamhuy1

    biết vẽ rectang

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

Đã gửi 14 September 2014 - 03:30 PM

Em cũng muốn tập tành lisp, nhưng kiến thức rỗng nhiều, chắc bái a Duân làm sư phụ :(


  • 0

#1857 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 14 September 2014 - 04:07 PM

Em cũng muốn tập tành lisp, nhưng kiến thức rỗng nhiều, chắc bái a Duân làm sư phụ  :(

Có rất nhiều các bậc cao thủ, mình chỉ là môn sinh thôi. Tự học mót nên viết 1 số ứng dụng thôi.

Bạn học bác Doan Van Ha, anh Tot77, bác Phamthanhbinh, Ketxu, Tien2005, Gia_Bach, Nguyen Hoanh, Tue_NV, .................ấy

Mình còn non lắm


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1858 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 15 September 2014 - 09:57 AM

Có nhiều cách để xác định đoạn thẳng nằm trên đoạn thẳng thật đấy. Cách của anh Tot77 hay thiệt, Anh có nhiều võ thật đó. Anh không cẩn thận em học hết đấy. ^^

Anh có rất nhiều võ cho những thuật toán nhanh gọn và chính xác. Em rất muốn được học hỏi ở anh.

Em cũng được giải đáp rất nhiều thắc mắc từ những câu trả lời của bác Doan Van Ha, anh Tue_NV ...........Cảm ơn các anh và các bác nhiều. :D


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#1859 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 15 September 2014 - 10:13 AM

Cái khó khi viết code là ở cái thuật toán, mà thuật toán thì chẳng ai dạy, chỉ có tự mình suy nghĩ để tìm ra thôi.


  • 0

#1860 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 992 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 15 September 2014 - 10:47 AM

Dạ vâng. Đúng như thế. Thuật toán quan trọng nhất đối với người lập trình.


  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn