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

tryhi

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

vectra

1. (defun c:tt (/ code ent n obj p pr)
   
2. 
   
3.   (princ "\n选择多段线上要移除的顶点:")
   
4.   (setq ent (ssget ":S" '((0 . "*POLYLINE"))))
   
5. 
   
6.   (if ent
   
7.     (progn
   
8.       (setq ent (ssname ent 0))
   
9.       (redraw ent 3)
   
10. 
    
11.       (setq p  (getpoint "指定顶点:")
    
12.       obj  (vlax-ename->vla-object ent)
    
13.       p  (vlax-curve-getclosestpointto obj (trans p 1 0))
    
14.       n  (fix (+ 0.5 (vlax-curve-getparamatpoint obj p))) ;_ 所选的顶点序号
    
15.       pr  (vlax-safearray->list
    
16.       (vlax-variant-value (vla-get-coordinate obj n))
    
17.     )
    
18.       )
    
19.       (cond
    
20.   ((= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
    
21.    (setq code (entget ent)
    
22.          code (vl-remove-if '(lambda (x) (equal pr (cdr x) 0.1)) code)
    
23.    )
    
24.    (entmod code)
    
25.   )
    
26. 
    
27.   ((= "POLYLINE" (cdr (assoc 0 (entget ent))))
    
28.    (while  (and (setq ent (entnext ent))
    
29.          (/= "SEQEND" (cdr (assoc 0 (entget ent))))
    
30.     )
    
31.      (if (and (= "VERTEX" (cdr (assoc 0 (entget ent))))
    
32.         (equal (cdr (assoc 10 (entget ent))) pr 0.1)
    
33.          )
    
34.        (vla-delete (vlax-ename->vla-object ent))
    
35.      )
    
36.    )
    
37.   )
    
38.       )
    
39. 
    
40.       (redraw ent 4)
    
41.     )
    
42.   )
    
43.   (princ)
    
44. )

(defun c:tt (/ code ent n obj p pr)<br /> <br />   (princ "\n选择多段线上要移除的顶点:")<br />   (setq ent (ssget ":S" '((0 . "*POLYLINE"))))<br /> <br />   (if ent<br />     (progn<br />       (setq ent (ssname ent 0))<br />       (redraw ent 3)<br /> <br />       (setq p  (getpoint "指定顶点:")<br />       obj  (vlax-ename->vla-object ent)<br />       p  (vlax-curve-getclosestpointto obj (trans p 1 0))<br />       n  (fix (+ 0.5 (vlax-curve-getparamatpoint obj p))) ;_ 所选的顶点序号<br />       pr  (vlax-safearray->list<br />       (vlax-variant-value (vla-get-coordinate obj n))<br />     )<br />       )<br />       (cond<br />   ((= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))<br />    (setq code (entget ent)<br />          code (vl-remove-if '(lambda (x) (equal pr (cdr x) 0.1)) code)<br />    )<br />    (entmod code)<br />   )<br /> <br />   ((= "POLYLINE" (cdr (assoc 0 (entget ent))))<br />    (while  (and (setq ent (entnext ent))<br />          (/= "SEQEND" (cdr (assoc 0 (entget ent))))<br />     )<br />      (if (and (= "VERTEX" (cdr (assoc 0 (entget ent))))<br />         (equal (cdr (assoc 10 (entget ent))) pr 0.1)<br />          )<br />        (vla-delete (vlax-ename->vla-object ent))<br />      )<br />    )<br />   )<br />       )<br /> <br />       (redraw ent 4)<br />     )<br />   )<br />   (princ)<br /> )

ysq101

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

lucas_3333

根本不用求助，搜搜就有

838510233

iamhuangjinming

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

vladimir

非常不错的程序，谢谢楼主分享