Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
21 replies to this topic

#1 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 06 November 2012 - 04:26 PM


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 !
  • 0

#2 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 06 November 2012 - 04:51 PM

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

* 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 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 06 November 2012 - 08:57 PM


(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à !
  • 0

#4 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 06 November 2012 - 09:10 PM


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?
  • 1

#5 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 06 November 2012 - 09:36 PM

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

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


#6 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 06 November 2012 - 09:37 PM

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)!
  • 0

#7 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 06 November 2012 - 10:02 PM

Đâ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))
  • 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.


#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 07 November 2012 - 06:35 AM

Tue_NV cũng viết 1 cái ở đây nè bạn
http://www.cadviet.c...ic=59727&st=160
Bài viết số 173. Để có fuzz giống LM thì chỉ sửa lại trong code 1 tí là xong
  • 0

#9 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 07 November 2012 - 07:56 AM

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!
  • 0

#10 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

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

Đã gửi 07 November 2012 - 09:00 AM

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

#11 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 07 November 2012 - 09:15 AM

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

  • 1

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


#12 victor85

victor85

    biết lệnh stretch

  • Members
  • PipPipPip
  • 169 Bài viết
Điểm đánh giá: 10 (tàm tạm)

Đã gửi 07 November 2012 - 11:48 AM

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

#13 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 07 November 2012 - 12:18 PM

overkill thì 2007 đã có, nhưng khô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.


#14 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 07 November 2012 - 12:28 PM

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

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#15 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 November 2012 - 01:44 PM

Bạn xem giúp mình dùng báo lỗi
Chon Lwpolyline: ; error: no function definition: LM:UNIQUEFUZZ
Cám ơn !
  • 0

#16 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 07 November 2012 - 02:01 PM

Ấy chết! Srr bạn, down lại nhé! Mình đã sửa.
  • 1

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


#17 LoveLisp

LoveLisp

    biết lệnh extend

  • Members
  • PipPipPip
  • 195 Bài viết
Điểm đánh giá: 20 (tàm tạm)

Đã gửi 07 November 2012 - 02:02 PM

wow... code của bác Hà thật là ngắn gọn và súc tích! Thật đáng khâm phục!
  • 0

#18 leehai209

leehai209

    biết pan

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

Đã gửi 07 November 2012 - 03:30 PM


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!! @@@@
  • 0

#19 NguyenNgocSon

NguyenNgocSon

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 368 Bài viết
Điểm đánh giá: 39 (tàm tạm)

Đã gửi 07 November 2012 - 05:05 PM

Bạn hỏi lạ quá nhỉ ?
Bạn đã đăng được bài để hỏi rồi mà ?
HI
  • 0

#20 leehai209

leehai209

    biết pan

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

Đã gửi 08 November 2012 - 10:53 AM

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!!!! :((
  • 0