Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
14 replies to this topic

#1 united

united

    biết vẽ arc

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

Đã gửi 13 September 2016 - 12:16 PM

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/5...616a6a6a/Ex.dwg


  • 0

#2 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 13 September 2016 - 06:44 PM

Lệnh là CungPoly Bạn nhé

https://drive.google...WXNnZjRwWjBlakU


  • 1

#3 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 13 September 2016 - 08:28 PM

Lệnh là CungPoly Bạn nhé

https://drive.google...WXNnZjRwWjBlakU

Thiếu hàm...!

Error: no function definition: CDRR


  • 0

#4 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 13 September 2016 - 08:56 PM

Thiếu hàm...!

Error: no function definition: CDRR

Bạn down lại:

https://drive.google...WXNnZjRwWjBlakU


  • 1

#5 united

united

    biết vẽ arc

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

Đã gửi 14 September 2016 - 11:49 AM

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


  • -1

#6 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 15 September 2016 - 08:16 AM

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

Tí sặc ^^
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#7 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 15 September 2016 - 09:48 AM

Đã 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. :)


  • 1

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

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

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?


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


#9 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 15 September 2016 - 10:36 AM

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.


  • 1

#10 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 673 Bài viết
Điểm đánh giá: 315 (khá)

Đã gửi 15 September 2016 - 10:37 AM

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...iew?usp=sharing

Lệnh RVT

 


  • 1

#11 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 15 September 2016 - 11:02 AM

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...iew?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)


  • 1

#12 united

united

    biết vẽ arc

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

Đã gửi 16 September 2016 - 09:04 AM

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.


  • 0

#13 ndtnv

ndtnv

    biết lệnh minsert

  • Members
  • PipPipPipPipPipPip
  • 437 Bài viết
Điểm đánh giá: 384 (khá)

Đã gửi 16 September 2016 - 11:34 AM

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


  • 1

#14 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5685 Bài viết
Điểm đánh giá: 2606 (tuyệt vời)

Đã gửi 16 September 2016 - 02:35 PM

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 :)
  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#15 DuongTrungHuy

DuongTrungHuy

    biết lệnh copy

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

Đã gửi 16 September 2016 - 04:54 PM

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


  • 1