[LISP函数]：添加多段线顶点的VLISP函数

highflybird

难道不可以用pedit 来添加么？
命令: pe PEDIT 选择多段线或 [多条(M)]:
输入选项
[闭合(C)/合并(J)/宽度(W)/编辑顶点(E)/拟合(F)/样条曲线(S)/非曲线化(D)/线型生成(L)
/放弃(U)]: e
输入顶点编辑选项
[下一个(N)/上一个(P)/打断(B)/插入(I)/移动(M)/重生成(R)/拉直(S)/切向(T)/宽度(W)/
退出(X)] <N>: i
指定新顶点的位置:
输入顶点编辑选项
[下一个(N)/上一个(P)/打断(B)/插入(I)/移动(M)/重生成(R)/拉直(S)/切向(T)/宽度(W)/
退出(X)] <N>: x
输入选项
[闭合(C)/合并(J)/宽度(W)/编辑顶点(E)/拟合(F)/样条曲线(S)/非曲线化(D)/线型生成(L)
/放弃(U)]

2. 
   
3. (defun C:test (/ ent obj pt1 index pt pts)
   
4.   (while
   
5.     (and
   
6.       (setq ent (entsel))
   
7.       (setq obj (vlax-ename->vla-object (car ent)))
   
8.       (setq pt1 (vlax-curve-getClosestPointTo obj (cadr ent)))
   
9.       (setq index (fix (vlax-curve-getParamAtPoint obj pt1)))
   
10.       (setq pt (getpoint "\n请输入添加的点:"))
    
11.       (setq pt (reverse (cdr (reverse pt))))
    
12.       (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 1)))
    
13.       (vlax-safearray-fill pts pt)
    
14.       (vlax-method-applicable-p obj 'AddVertex)
    
15.     )
    
16.     (vla-AddVertex obj (1+ index) pts)
    
17.   )
    
18.   (princ)
    
19. )
    

<br /> (defun C:test (/ ent obj pt1 index pt pts)<br />   (while<br />     (and<br />       (setq ent (entsel))<br />       (setq obj (vlax-ename->vla-object (car ent)))<br />       (setq pt1 (vlax-curve-getClosestPointTo obj (cadr ent)))<br />       (setq index (fix (vlax-curve-getParamAtPoint obj pt1)))<br />       (setq pt (getpoint "\n请输入添加的点:"))<br />       (setq pt (reverse (cdr (reverse pt))))<br />       (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 1)))<br />       (vlax-safearray-fill pts pt)<br />       (vlax-method-applicable-p obj 'AddVertex)<br />     )<br />     (vla-AddVertex obj (1+ index) pts)<br />   )<br />   (princ)<br /> )<br />

这是vlisp程序。
如果你要的是3dpoly 恐怕不是这样的了。

2. 
   
3. (defun C:tt (/ ent obj pt1 index pt pts)
   
4.   (and
   
5.     (setq ent (entsel))
   
6.     (setq obj (vlax-ename->vla-object (car ent)))
   
7.     (setq pt (getpoint "\n请输入添加的点:"))
   
8.     (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 2)))
   
9.     (vlax-safearray-fill pts pt)
   
10.     (vlax-method-applicable-p obj 'AppendVertex)
    
11.     (vla-AppendVertex obj pts)
    
12.   )
    
13.   (princ)
    
14. )
    

<br /> (defun C:tt (/ ent obj pt1 index pt pts)<br />   (and<br />     (setq ent (entsel))<br />     (setq obj (vlax-ename->vla-object (car ent)))<br />     (setq pt (getpoint "\n请输入添加的点:"))<br />     (setq pts (vlax-make-safearray vlax-vbdouble '(0 . 2)))<br />     (vlax-safearray-fill pts pt)<br />     (vlax-method-applicable-p obj 'AppendVertex)<br />     (vla-AppendVertex obj pts)<br />   )<br />   (princ)<br /> )<br />

zbwei120

不错，支持楼主的程序

w379106181

谢谢分享谢谢分享谢谢分享谢谢分享谢谢分享