Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
united

[Yêu Cầu] Lisp Bỏ Bớt Đỉnh (Vertex) Polyline.

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

Trước tiên xin cảm ơn các bác vì đã quan tâm!

Như tiêu đề, em xin nhờ các bác viết giùm em lisp với nội dung là bỏ bớt đỉnh của một (hay nhiều) polyline với nguyên tắc: cách 1 đỉnh thì bỏ bớt 1 đỉnh. Tất nhiên  là phải giữ lại đỉnh đầu tiên (cả đỉnh cuối cùng thì càng tốt) khi polyline không kín.

Chả là em hay làm việc trên bản đồ địa hình đồi núi, khi các đường đồng mức có vertex dày đặc thì bản vẽ rất nặng.

Rất mong các bác giúp đỡ.

Xin cảm ơn các bác lần nữa!

 

PS: Ví dụ với bản vẽ này (xin lỗi các bác vì up trên 4r mãi không được):

http://4share.vn/f/586d6968616a6a6a/Ex.dwg

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

Đã ngon! Nhưng không có lisp hả bác?

:) Chào Bạn. Mình tưởng Bạn chỉ quan tâm đến kết quả, còn nếu muốn tìm hiểu thêm đường đi cho mình mail mình gửi nhé! Làm tí bí ẩn cho vui chứ cái này trình làng ra sợ người đọc cười.

 

À Mình lọai bỏ đỉnh theo quan điểm nếu góc của 2 cạnh tại đỉnh < 0.04 rad thì lọai ... (bạn xem trong chương trình thì rõ)

và đường cũ thì chuyển vào layer số 0 để so sánh và lỡ có tiếc thì lấy lại. :)

  • 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

Mình cũng táy máy chuyển thử 1 pline 9 đỉnh. Kết quả: "9 --> 9 dinh". Vì sao vậy bạn?

À có thể là do đường Poly đó không nên làm cứng đó Hạ. Mình qui ước chỉ nên bỏ những đỉnh "thừa" thôi, ví dụ nhưng đỉnh mà gần như trên 1 đường thẳng còn nếu những đỉnh mà dẫn đến cua gấp thì nên để lại. Hạ cũng là 1 tay CadViet lâu năm rồi chắc rành mà. Chào :)

 

Mình làm nghề hay gặp Poly có đến nhiều ngàn đỉnh nên máy đơ luôn,n viết cái này để tém cho gọn bớt.

  • 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

Mình cũng táy máy chuyển thử 1 pline 9 đỉnh. Kết quả: "9 --> 9 dinh". Vì sao vậy bạn?

Bác Hạ, tác giả viết không theo điều kiện của chủ thớt (cách 1 đỉnh thì bỏ bớt 1 đỉnh), mà là: lọai bỏ đỉnh theo quan điểm nếu góc của 2 cạnh tại đỉnh < 0.04 rad thì lọai.

@DuongTrungHuy: Thuật toán để so sánh góc nó dài đến vậy à? Thấy file của bạn có dung lượng 26-27 KB.

Mình cũng có làm 1 cái, nhưng so sánh khoảng cách giữa 2 điểm, dung lương chỉ có 1.7KB.

,https://drive.google.com/file/d/0B2LetfHDljPGVlNWRXdwNFc4bG8/view?usp=sharing

Lệnh RVT

 

  • 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

Bác Hạ, tác giả viết không theo điều kiện của chủ thớt (cách 1 đỉnh thì bỏ bớt 1 đỉnh), mà là: lọai bỏ đỉnh theo quan điểm nếu góc của 2 cạnh tại đỉnh < 0.04 rad thì lọai.

@DuongTrungHuy: Thuật toán để so sánh góc nó dài đến vậy à? Thấy file của bạn có dung lượng 26-27 KB.

Mình cũng có làm 1 cái, nhưng so sánh khoảng cách giữa 2 điểm, dung lương chỉ có 1.7KB.

,https://drive.google.com/file/d/0B2LetfHDljPGVlNWRXdwNFc4bG8/view?usp=sharing

Lệnh RVT

À có lẽ do thuật tóan mình chưa tối ưu lắm. Nhưng thôi cũng có xài là được đó Mạnh :) cái này đơn giản mà không đáng để mất thời gian phải không Bạn. Mình đọc thấy có người có y/c tương tự nên đưa lên thôi, Mình làm bên khảo sát nên đôi khi gặp đường đồng mức Poly quá mịn cũng nặng máy lắm, xóa bớt các đỉnh "thừa" cho nhẹ máy ấy mà.

 

À mà có lẽ trong đó mình có dịch thừa thêm file DCL của mình thêm nên nó nặng kB đo Bạn (dich bỏ DCL nó bắt lỗi, ghét :), mình bỏ vô luôn khỏi lằng nhằ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

Tí sặc ^^

Bác sặc cái gì thế ạ?

Em có ngu thì em mới lên đây hỏi chứ!

Em xin file .lsp là để sửa cái lệnh cho nó ngắn lại 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

Muốn sửa lệnh cho nó ngắn lại đâu cần file lisp

1 - Dùng lệnh ALIASEDIT hay thêm trực tiếp trong acad.pgp

2 - Dùng lisp để gọi:

(defun C:1 () (C:CungPoly))

  • 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

Bác sặc cái gì thế ạ?

Em có ngu thì em mới lên đây hỏi chứ!

Em xin file .lsp là để sửa cái lệnh cho nó ngắn lại thôi.

Mình k nói đến chuyện khôn hay k khôn, ý mình là người ta viết ra, đương nhiên có mã, có điều có muốn gửi mã hay k thôi :)
  • 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

Bác sặc cái gì thế ạ?

Em có ngu thì em mới lên đây hỏi chứ!

Em xin file .lsp là để sửa cái lệnh cho nó ngắn lại thôi.

Hì muốn lệnh ngắn đi Bạn cũng có thể vào trong tập tin acad.pgp rồi đặt tên lệnh tắt vào đó nếu Bạn cảm thấy lệnh này hay dùng.

Có lẽ Bạn cũng làm nghề tương tự mình, gặp các Poly như vậy rất chán. Ban đầu mình cũng nghĩ là bớt theo kiểu của Bạn nhưng như vậy đôi khi lại bỏ đỉnh cái ko nên bỏ, nên bỏ theo kiểu này. Hì lâu quá cũng quên hình như có thêm 2 điều kiện gì đó là kc<0.5 v.v... Chúc Bạn công tác tốt.

 

Chương trình thì nó đây Bạn. Các Bạn xem rồi đừng cười chê nhé!

 

(defun MakePoly (Lop dsdinhP / ndinh0 ds0a dsa)

  (setq ds0a '() ndinh0 (length dsdinhP))

  (Foreach pt dsdinhP

     (setq ds0a (append ds0a (list (cons 10 pt))))

  )

  (setq dsa (append (list (cons 0 "LWPOLYLINE"))

                    (list (cons 100 "AcDbEntity"))

                    (list (cons 100 "AcDbPolyline"))

                    (list (cons 8 lop))

                    (list (cons 90 ndinh0))

                    ds0a

            )

  )

  (entmake dsa)

)

 

(defun cdrr(ds1 / dsbo)

  (setq dsbo1 (reverse (cdr (reverse ds1))))

)

 

 

(defun c:CungPoly(/ i ss1)

  (If (Setq ipt 0 ss1 (ssget  (list (cons 0 "LWPOLYLINE"))))

  (Progn

    (Setvar "cmdecho" 0)

    (Repeat (sslength ss1)

      (setq e1 (ssname ss1 ipt) ipt (1+ ipt) lop (cdr (assoc 8 (entget e1)))

            dsdinh (mapcar '(lambda (x) (cdrr x)) (acet-geom-vertex-list e1))

            ndinh (length dsdinh) dskq (list (car dsdinh) (cadr dsdinh))

            d1 (car dskq) d0 (cadr dskq) nbo 1 goc2 (angle d1 d0) i 3

      )

      (Repeat (- ndinh 3)

        (setq d2 (nth (1- i) dsdinh) i (1+ i) goc1 (- (angle d0 d2) goc2)

              kc (distance d0 d2) goc goc1

        )

        (If (< goc1 0.000001)(setq goc (- pi goc1)))

        (If (or (and (> (abs (- pi goc)) 0.04) (> kc 0.5))(> nbo 3))

          (setq nbo 1 dskq (append dskq (list d2)) d1 d0 d0 d2 goc2 (angle d1 d0))

          (setq nbo (1+ nbo))

        )    

      )

      (setq dskq (append dskq (list (last dsdinh))))

      (MakePoly lop dskq)

      (Redraw (entlast) 3)

      (command "change" e1 "" "p" "la" "0" "")  

      (princ (strcat "\n" (itoa ndinh) " --> " (itoa (length dskq)) " dinh."))

    )

    (princ)

  )

  )  

)

  • 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

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  

×