多段线顶点太多，如何过滤删除多余的点？[已解决]

天天问

这个问题已经自己解决了，详见我的帖子里的附件，链接在此：http://bbs.mjtd.com/thread-185068-1-1.html

================以下是原贴===================
平时会遇到多段线顶点非常密的线条，对其进行操作时软件很卡顿。
有一些软件/插件会有一种功能：把多段线顶点抽稀，在给定精度下尽量保持多段线的线条样子。
已知的有南方CASS里的复合线滤波、ZDM里的多段线减点。


不知道群里有没有朋友收藏的有lsp程序具有类似功能。


================以下是原贴===================
平时会遇到多段线顶点非常密的线条，对其进行操作时软件很卡顿。
有一些软件/插件会有一种功能：把多段线顶点抽稀，在给定精度下尽量保持多段线的线条样子。
已知的有南方CASS里的复合线滤波、ZDM里的多段线减点。


不知道群里有没有朋友收藏的有lsp程序具有类似功能。

wzg356

;多线段节点抽稀
;(delpiont pts nil);符合三点一线规则时，抽掉中间点
;(delpiont pts 10);符合三点一线规则时，抽掉中间点。抽掉点间距小于d的点
(defun delpiont (pts d / nthrm yy-3ptinline yy-3ptdstance pts1)
(defun nthrm (n lst)
  (if (null lst)   nil
    (if (zerop n) (cdr lst)
      (cons (car lst) (nthrm (- n 1) (cdr lst)))
    )
  )
)
(defun yy-3ptinline (p1 p2 p3 / v1 v2)
    (setq v1 (mapcar '- p1 p2) v2 (mapcar '- p1 p3))
    (if (equal (car v1) 0.0 1e-4)
        (equal (car v1) (car v2) 1e-4)
        (equal (abs(/ (cadr v1) (car v1))) (abs(/ (cadr v2) (car v2))) 1e-4)
    )
)
(setq pts1 nil)
(while (> (length pts) 2)
        (if        (or        (yy-3ptinline (car pts) (cadr pts) (caddr pts));三点一线法
                        (if d(< (distance (car pts) (cadr pts)) d));距离法       
                )
                (setq pts(nthrm 1 pts))
                (setq pts1 (cons (car pts) pts1)
                    pts (cdr pts)
                )       
        )
)
(cons (cadr pts)(cons (car pts) pts1))
)

;[功能]entmake生成多段线
(defun Ent:Make_2DPoly (pts / e)
  (setq e (Entmake (list '(0 . "POLYLINE") '(70 . 0))))
  (foreach p pts
    (entmake (list '(0 . "VERTEX") '(70 . 0) (cons 10 p)))
  )
  (entmake '((0 . "SEQEND")))
  e
)
(defun makeplc(pts)
(entmakex(append(mapcar 'cons (list 0 100 100 90 38 43)
(list "LWPOLYLINE" "AcDbEntity" "AcDbPolyline" (length pts)  0 0.0))
(mapcar '(lambda (p)(cons 10 p)) pts)))
)
(defun c:pldp ( / E pts)
        (and(setq e(ssget ":E:S" '((0 . "LWPOLYLINE"))))
                (setq e(ssname e 0))
                (setq pts (mapcar 'cdr (vl-remove-if  '(lambda (x) (/= (car x) 10))(entget e))))
                (makeplc (delpiont pts 10.));抽掉中间点，抽掉点间距小于10的点后的新线
                (command "_matchprop" e (entlast) "")
        )       
)

天天问

wzg356 发表于 2022-3-19 19:21
;多线段节点抽稀
;(delpiont pts nil);符合三点一线规则时，抽掉中间点
;(delpiont pts 10);符合三点一线 ...

大佬，您这个程序是仅适用于多点共线时抽稀吗？
曲线上节点过于密集时能不能用？

我用在曲线上失败了，用在多点共线的时候没问题。

wzg356

最小点间距要合适

magicheno

感谢大佬分享

依然小小鸟

感谢分享