tryhi 发表于 2015-2-5 22:12:30

如何删除多边形的多余顶点


http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101010
找到这个帖子，但是不行，我想这样，输入一个命令，然后选择一个多边形，然后再点击那个点，然后就那个顶点就删掉





vectra 发表于 2015-2-5 22:12:31

本帖最后由 vectra 于 2015-2-5 22:54 编辑

(defun c:tt (/ code ent n obj p pr)

(princ "\n选择多段线上要移除的顶点:")
(setq ent (ssget ":S" '((0 . "*POLYLINE"))))

(if ent
    (progn
      (setq ent (ssname ent 0))
      (redraw ent 3)

      (setq p(getpoint "指定顶点:")
      obj(vlax-ename->vla-object ent)
      p(vlax-curve-getclosestpointto obj (trans p 1 0))
      n(fix (+ 0.5 (vlax-curve-getparamatpoint obj p))) ;_ 所选的顶点序号
      pr(vlax-safearray->list
      (vlax-variant-value (vla-get-coordinate obj n))
    )
      )
      (cond
((= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
   (setq code (entget ent)
         code (vl-remove-if '(lambda (x) (equal pr (cdr x) 0.1)) code)
   )
   (entmod code)
)

((= "POLYLINE" (cdr (assoc 0 (entget ent))))
   (while(and (setq ent (entnext ent))
         (/= "SEQEND" (cdr (assoc 0 (entget ent))))
    )
   (if (and (= "VERTEX" (cdr (assoc 0 (entget ent))))
      (equal (cdr (assoc 10 (entget ent))) pr 0.1)
         )
       (vla-delete (vlax-ename->vla-object ent))
   )
   )
)
      )

      (redraw ent 4)
    )
)
(princ)
)

ysq101 发表于 2015-2-5 22:18:53

搜一下关于多线段。。。里面有很全的关于多线段的处理。。
黄大师出品

lucas_3333 发表于 2015-2-5 22:26:05

根本不用求助，搜搜就有

838510233 发表于 2015-2-5 22:26:20

iamhuangjinming 发表于 2016-6-30 08:24:38

应该有用，收藏了，谢谢分享

vladimir 发表于 2020-12-14 22:18:38

非常不错的程序，谢谢楼主分享
页: [1]
查看完整版本: 如何删除多边形的多余顶点