用VLa法给多段线增加一个顶点，然后删除

/db_自贡黄明儒_

2. 
   
3. ;;用VLa法给多段线增加一个顶点，然后删除
   
4. (defun C:w2 (/ L OBJ P PT PTS)
   
5.   (setq obj (vlax-ename->vla-object (car (entsel))))
   
6.   (setq pt (getpoint))
   
7.   (setq pt (mapcar '+ '(0 0) pt))
   
8.   ;;增加
   
9.   (vlax-invoke obj 'addvertex 2 pt)
   
10.   ;;删除增加点
    
11. 
    
12.   (setq pts (vlax-get obj 'coordinates))
    
13.   (while (setq P   (list (car pts) (cadr pts))
    
14.                L   (cons p L)
    
15.                pts (cddr pts)
    
16.          )
    
17.   )
    
18.   (setq L (reverse L))
    
19.   (setq L (vl-remove (nth 2 L) L))
    
20.   (setq L (apply 'append L))
    
21.   (vlax-put obj 'coordinates L)
    
22. 
    
23. )

<br /> ;;用VLa法给多段线增加一个顶点，然后删除<br /> (defun C:w2 (/ L OBJ P PT PTS)<br />   (setq obj (vlax-ename->vla-object (car (entsel))))<br />   (setq pt (getpoint))<br />   (setq pt (mapcar '+ '(0 0) pt))<br />   ;;增加<br />   (vlax-invoke obj 'addvertex 2 pt)<br />   ;;删除增加点<br /> <br />   (setq pts (vlax-get obj 'coordinates))<br />   (while (setq P   (list (car pts) (cadr pts))<br />                L   (cons p L)<br />                pts (cddr pts)<br />          )<br />   )<br />   (setq L (reverse L))<br />   (setq L (vl-remove (nth 2 L) L))<br />   (setq L (apply 'append L))<br />   (vlax-put obj 'coordinates L)<br /> <br /> )

sh_h

谢谢黄总分享！！！

Lisphk

支持黄总。

kqqt6236

不用回复也能看。

liunian0524

感谢楼主分享

evayleung

支持一下，但为啥加了又要删掉呢？请指教下

yjch

好好学习天天向上，支持

434939575

老大这个我用到 ： ;;删除增加点，打止（后面注释掉)，增加的点乱了。2007.pline线

yoyoho

感谢分享程序！！！

yxh1202

我用你的方法添加顶点后，线段变形了

yxh1202

黄老师，我按照你的增加了点想法，做出来的线乱了。是不是新加的点没有排序造成的，能否指点一下吗