社区 › Auto Lisp › 删除三维多段线的顶点

motee-z 发表于 2022-7-5 16:08:15

删除三维多段线的顶点

你好
如果水平距离小于先前顶点的0.05（例如），编写lisp的任何帮助都可以删除三维多段线选择的顶点
非常感谢。

David Bethel 发表于 2022-7-5 16:21:15

它可能看起来像这样：
 
[列表]
[*]根据需要编辑测试函数。
[*]非常危险，因此使用风险自负。
[*]保留第一个顶点，而不是以下顶点
[*]不适用于闭合或花键连接的柱脚
[/列表]
 

(defun c:3dp-rvtx (/ ss i en ed vn vd vl v1 v2)
(defun test (v1 v2)
   (> (abs (- (car v2) (car v1))) 0.5))

(setq ss nil)

(princ "\nSelect 3DPOLYlines....   ")
(while (not ss)
      (setq ss (ssget (list (cons 0 "POLYLINE")
                              (cons -4 "=")
                              (cons 70 8)))))
(setq i 0)
(while (setq en (ssname ss i))
      (setq ed (entget en)
            vn (entnext en)
            vd (entget vn)
            vl nil)
      (while (= "VERTEX" (cdr (assoc 0 vd)))
               (setq v1 (cdr (assoc 10 vd)))
               (cond ((= "SEQEND" (cdr (assoc 0 (entget (entnext vn)))))
                      (setq vl (cons v1 vl)))
                     (T
                      (and (setq v2 (cdr (assoc 10 (entget (entnext vn)))))
                           (test v1 v2)
                           (setq vl (cons v1 vl)))))
               (setq vn (entnext vn)
                     vd (entget vn)))
      (and vl
            (entdel en)
            (entmake ed)
            (foreach v (reverse vl)
            (entmake (list (cons 0 "VERTEX")(cons 10 v)(cons 70 32)
                           (assoc 8 ed)
                           (cons 62 (if (assoc 62 ed) (cdr (assoc 62 ed)) 256))
                           )))
            (entmake vd))
      (setq i (1+ i)))
(prin1))


 
 
-大卫

motee-z 发表于 2022-7-5 16:24:19

谢谢大卫先生的回复
Lisp程序对我来说很棒
你能让它删除沿着远处的顶点吗
非常感谢。

David Bethel 发表于 2022-7-5 16:34:32

对不起，我不理解你的要求-大卫

motee-z 发表于 2022-7-5 16:40:35

请检查要删除的顶点数（n+1）的图像
在lisp中，删除顶点数（n）

David Bethel 发表于 2022-7-5 16:46:58

正如我所说，保留第一个顶点，而不是下面的-David

Stefan BMR 发表于 2022-7-5 16:49:11

是0.5还是0.05？
这是一个适用于任何距离的版本。
(defun c:delvert ( / *error* msg ss d i e q a b l p)
(vl-load-com)
;;;(setq *error* (err))
(if
   (and
   (setq msg "\nNothing selected.")
   (setq ss (ssget "_:L" '((0 . "POLYLINE") (-4 . "&=") (70 .(-4 . "<NOT") (-4 . "&=") (70 . 4) (-4 . "NOT>"))))
   (setq msg "\nDistance required.")
   (progn
       (initget 6)
       (setq d (getdist "\nSpecify distance: "))
   )
   )
   (repeat (setq i (sslength ss))
   (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i))))
         q (vlax-curve-isclosed e)
         a (vlax-curve-getstartparam e)
         b (vlax-curve-getendparam e)
         l (list (vlax-curve-getstartpoint e))
         )
   (while (<= (setq a (1+ a)) b)
       (setq p (vlax-curve-getpointatparam e a))
       (if
         (> (distance p (car l)) d)
         (setq l (cons p l))
       )
   )
   (vlax-put e 'coordinates (apply 'append (reverse (if q (cdr l) l))))
   )
   (princ msg)
)
;;;(*error* nil)
(princ)
)

David Bethel 发表于 2022-7-5 16:59:13

什么决定了PLINE的方向？
 
我可以说最大的WCS X轴值是要保持的吗？

Stefan BMR 发表于 2022-7-5 17:03:16

在我的lisp中，多段线从头到尾迭代。如果到最后一个保留点的距离（3d距离）小于指定距离，则释放点。

motee-z 发表于 2022-7-5 17:09:43

谢谢大家

查看完整版本: 删除三维多段线的顶点