Chuyển đến nội dung
Diễn đàn CADViet
NguyenNgocSon

[Yêu cầu] Lisp xóa điểm trùng và sắp xếp lại đỉnh của LWPolyline

Bởi NguyenNgocSon , trong AutoLisp

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

NguyenNgocSon    43

NguyenNgocSon
Đã đăng 

             	LWPOLYLINE  Layer: "DS-Tim duong"
                       	Space: Model space
              	Handle = 62a
         	Open
Constant width	0.3000
         	area   0.0000
       	length   210.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 215.8515  Y=-315.6697  Z=   0.0000

Mình có 1LWPL có các điểm như sau nhưng có 1 số tọa độ điểm trùng nhau

Giờ mình muốn nhờ giúp viết Lisp để xóa các điểm trùng và sắp xếp lại đỉnh của LWPL

Cám ơ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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Nếu Lwpolyline không chứa arc thì bạn có thể làm như sau:

- Lấy list points của LW, được lst1.

- Sort lst1 để loại các phần tử trùng nhau, được lst2.

- Entmake LW mới cho lst2 + Delete LW 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

NguyenNgocSon    43

NguyenNgocSon
Đã đăng 

(defun C:vd()
(setq en(car (entsel "\n Select a Polyline :")))
(setq enlist(entget en))
(setq myVertexList(list))
(foreach a enlist                                  
(if(= 10 (car a))                                 
(setq myVertexList                           
 	(append myVertexList              
   	(list                                             
     	(cdr a)                                    
   	)                                                       
 	)                                                            
)                                                                 
 )                                                                      
)
'(setq pl(vl-sort(myVertexList)))
(princ)
(princ (vl-sort myVertexList '<))                                                                         
)

Hiện tại mình mới code chỉ làm được bước 1 => bước 2 + 3 nhờ bác trợ giúp ? Mình mới code mà !

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

Tue_NV
Đã đăng 

             	LWPOLYLINE  Layer: "DS-Tim duong"
                       	Space: Model space
  				Handle = 62a
         	Open
Constant width	0.3000
         	area   0.0000
       	length   210.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 215.8515  Y=-315.6697  Z=   0.0000

Mình có 1LWPL có các điểm như sau nhưng có 1 số tọa độ điểm trùng nhau

Giờ mình muốn nhờ giúp viết Lisp để xóa các điểm trùng và sắp xếp lại đỉnh của LWPL

Cám ơn !

Chưa hiểu ý:

1./ Bạn cần xây dựng lại LWPL mới trong đó các đỉnh của LWPL mới đó không trùng nhau ?

2./ Bạn sửa LWPL đó, trong đó các đỉnh của LWPL đó không trùng nhau ?

3./ Hay là bạn chỉ muốn lấy list các điểm của LWPL mà các phần tử trong list đó không trùng nhau?

  • 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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Hiện tại mình mới code chỉ làm được bước 1 => bước 2 + 3 nhờ bác trợ giúp ? Mình mới code mà !

Góp ý đầu tiên:

Bạn sort như vậy là chưa ổn. Sort để loại các điểm trùng nhau chứ không phải sort để loại các điểm có X hay Y bằng nhau.

  • 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

NguyenNgocSon    43

NguyenNgocSon
Đã đăng

Chưa hiểu ý:

1./ Bạn cần xây dựng lại LWPL mới trong đó các đỉnh của LWPL mới đó không trùng nhau ?

2./ Bạn sửa LWPL đó, trong đó các đỉnh của LWPL đó không trùng nhau ?

3./ Hay là bạn chỉ muốn lấy list các điểm của LWPL mà các phần tử trong list đó không trùng nhau?

Ý mình là loại điểm trùng của LWPL mà (theo ý 2)!

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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Đây là 1 hàm của LM để loại các phần tử gần trùng nhau, rất phù hợp để loại các điểm trùng nhau:

(defun LM:UniqueFuzz ( l fz ) (if l (cons (car l) (LM:UniqueFuzz (vl-remove-if '(lambda ( x ) (equal x (car l) fz)) (cdr l)) fz))))

EX:

Command: (LM:UniqueFuzz (list '(1. 2. 3.) '(1.001 2. 3.)) 0.1)

((1.0 2.0 3.0))

Command: (LM:UniqueFuzz (list '(1. 2. 3.) '(1.001 2. 3.)) 0.0001)

((1.0 2.0 3.0) (1.001 2.0 3.0))

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

LoveLisp    21

LoveLisp
Đã đăng

Bác Hà ơi!!

Nếu nó có chứa ARC thì sao hả bác? Hoặc nếu nó đã được hiệu chỉnh (bằng lệnh Pedit) thành Spline hoặc Fit thì làm sao để nó không thay đổi?? hihi.. câu hỏi này chắc là khó đây!

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

Tue_NV
Đã đăng

Bác Hà ơi!!

Nếu nó có chứa ARC thì sao hả bác? Hoặc nếu nó đã được hiệu chỉnh (bằng lệnh Pedit) thành Spline hoặc Fit thì làm sao để nó không thay đổi?? hihi.. câu hỏi này chắc là khó đây!

Pline có line segment khác với arc segment ở Bulge thôi

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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng

Nếu nhằm mục đích xóa tất cả các điểm trùng nhau của 1 Lwpolyline bất kỳ, không phân biệt có arc hay không, thì dùng lisp này (còn nếu có thêm điều kiện là chỉ xóa các điểm liên tiếp mà trùng nhau thì phải sửa lisp tí):

(defun C:HA( / ent)
(vl-load-com)
(if
 (and
  (setq ent (car (entsel "\nChon Lwpolyline: ")))
  (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)))))
 (entmod (LM:HA:UniqueFuzz (entget ent) 1E-8)))
(princ))
(defun LM:HA:UniqueFuzz (lst fz)
(if lst
 (cons (car lst) (LM:HA:UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))

  • 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

victor85    10

victor85
Đã đăng

từ cad 2010 trở lên bạn thử dùng lệnh: overkill xem sao!

  • 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

hochoaivandot    111

hochoaivandot
Đã đăng

từ cad 2010 trở lên bạn thử dùng lệnh: overkill xem sao!

 

Hay nhỉ :mellow:

Mình đã thử với với cad2013. Tuyệt!

 
Command: OVERkill
Select objects: 1 found
Select objects:
0 duplicate(s) deleted
5 overlapping object(s) or segment(s) deleted

 

Lệnh overkill của cad2007 thì chưa có chức năng xóa segment của pline bạn Doan Van Ha.

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

leehai209    0

leehai209
Đã đăng 

             	LWPOLYLINE  Layer: "DS-Tim duong"
                       	Space: Model space
          		Handle = 62a
         	Open
Constant width	0.3000
         	area   0.0000
       	length   210.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  35.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  65.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X=  95.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 125.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 155.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 185.8515  Y=-315.6697  Z=   0.0000
     	at point  X= 215.8515  Y=-315.6697  Z=   0.0000

Mình có 1LWPL có các điểm như sau nhưng có 1 số tọa độ điểm trùng nhau

Giờ mình muốn nhờ giúp viết Lisp để xóa các điểm trùng và sắp xếp lại đỉnh của LWPL

Cám ơn !

Bạn ơi! cho mình hỏi làm thế nào để đăng bài lên diễn đàn được vậy? Mình đang cần xin bản Cad 2005 để chạy nova, kẻo mình mua mà không có đĩa, download về thì lỗi tùm lum

Cảm oqn bạn nhiều nha!! @@@@

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

leehai209    0

leehai209
Đã đăng

Bạn hỏi lạ quá nhỉ ?

Bạn đã đăng được bài để hỏi rồi mà ?

HI

À, thế là mình đăng được rùi à! hihi, ít hiểu biết rùi

Mà bạn có đung cad 2005 không cho mình xin với, mình đang cần mà không load đượ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

thanhlong.hygt    9

thanhlong.hygt
Đã đăng

Nếu nhằm mục đích xóa tất cả các điểm trùng nhau của 1 Lwpolyline bất kỳ, không phân biệt có arc hay không, thì dùng lisp này (còn nếu có thêm điều kiện là chỉ xóa các điểm liên tiếp mà trùng nhau thì phải sửa lisp tí):

(defun C:HA( / ent)
(vl-load-com)
(if
  (and
   (setq ent (car (entsel "\nChon Lwpolyline: ")))
   (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)))))
  (entmod (LM:HA:UniqueFuzz (entget ent) 1E-8)))
(princ))
(defun LM:HA:UniqueFuzz (lst fz)
(if lst
  (cons (car lst) (LM:HA:UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))

Bạn có thể giúp mình bổ sung thêm chức năng nhập khoảng cách min bỏ đỉnh không. Nếu khoảng cách nhỏ hơn khoảng cách min thì bỏ đỉnh nếu khoảng cách lớn hơn thì  giữ nguyên lại đỉnh. thank 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

Trần Kuly    0

Trần Kuly
Đã đăng

 

Hay nhỉ :mellow:

Mình đã thử với với cad2013. Tuyệt!

 Command: OVERkill
Select objects: 1 found
Select objects:
0 duplicate(s) deleted
5 overlapping object(s) or segment(s) deleted

Lệnh overkill của cad2007 thì chưa có chức năng xóa segment của pline bạn Doan Van Ha.

CAI NAY BAO LOI ; error: no function definition: S  BAC hochoaivandot oi! sua giup em voi! thanks bac!

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

thanhduan2407    272

thanhduan2407
Đã đăng
Vào lúc 7/11/2012 tại 09:15, Doan Van Ha đã nói:

Nếu nhằm mục đích xóa tất cả các điểm trùng nhau của 1 Lwpolyline bất kỳ, không phân biệt có arc hay không, thì dùng lisp này (còn nếu có thêm điều kiện là chỉ xóa các điểm liên tiếp mà trùng nhau thì phải sửa lisp tí):

  


(defun C:HA( / ent)
(vl-load-com)
(if
 (and
  (setq ent (car (entsel "\nChon Lwpolyline: ")))
  (= "LWPOLYLINE" (cdr (assoc 0 (entget ent)))))
 (entmod (LM:HA:UniqueFuzz (entget ent) 1E-8)))
(princ))
(defun LM:HA:UniqueFuzz (lst fz)
(if lst
 (cons (car lst) (LM:HA:UniqueFuzz (vl-remove-if '(lambda (x) (if (= 10 (car x)) (equal x (car lst) fz))) (cdr lst)) fz))))
 

 

Bác @Doan Van Ha ơi! Giả sử nó có ARC mà điểm cuối của ARC trùng với điểm đầu Pline thì sẽ như nào vậy bác? nếu lisp trên thì nó xoá mất cung tròn của cháu. 

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

Doan Van Ha    3.180

Doan Van Ha
Đã đăng
12 giờ trước, thanhduan2407 đã nói:

Bác @Doan Van Ha ơi! Giả sử nó có ARC mà điểm cuối của ARC trùng với điểm đầu Pline thì sẽ như nào vậy bác? nếu lisp trên thì nó xoá mất cung tròn của cháu. 

Với người biết lisp thì điều này đâu khó lắm? Tự làm thử xem.

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

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
Về Đầu Trang AutoLisp
×