平行多段线的顶点连线

gwpgc

这个个lisp程序只能单选，希望老大们能帮我改成框选，先谢了。
程序如下：

1. defun c:pxlj(/ e1 e2 vla_e1 vla_e2 pts1 pts2 fglst lst_dist&p)
   
2.   (setq e1(car(entsel"\n 选择第一条曲线："))
   
3.   e2(car(entsel"\n 选择第二条曲线："))
   
4.   vla_e1(vlax-ename->vla-object e1)
   
5.   vla_e2(vlax-ename->vla-object e2)
   
6.   pts1(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e1)))
   
7.   pts2(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e2)))
   
8.   )
   
9.   (fgb pts1)
   
10.   (setq pts1 fglst fglst nil)
    
11.   (fgb pts2)
    
12.   (setq pts2 fglst fglst nil)
    
13.   (setq i 0 m 0)
    
14.   (while(< i(length  pts1))
    
15.      (setq x (nth i pts1))
    
16.      (while (< m(length  pts2))
    
17.        (setq y (nth m pts2))
    
18. 
    
19.        (setq lst_dist&p (append lst_dist&p (list(list x y (distance x y)))))
    
20.        (setq m(1+ m))
    
21.         )
    
22.     (setq lst_dist&p(vl-sort lst_dist&p(function(lambda(x1 x2)(< (caddr x1)(caddr x2))))))
    
23.     (command "line" (caar lst_dist&p)(cadar lst_dist&p) "")
    
24.     (setq pts1(vl-remove (caar lst_dist&p) pts1)
    
25.     pts2(vl-remove (cadar lst_dist&p) pts2)
    
26.     )
    
27.     (setq lst_dist&p nil)
    
28.     (if(not  pts1)(setq i (1+ i)))
    
29.     (if(not  pts2)(setq m (1+ m))(setq m 0))
    
30.      )
    
31.   )
    
32.    
    
33. ;;;;;;;;;;;;;;;;;;;;;;;;;;;将表内元素每2个进行分割重新组表;;;;;;;;;;;;;;;;;;;;;;;;;
    
34. (defun fgb(lst1 / fglst1 dxf10 n)
    
35. (setq n 0 i 0)
    
36. (repeat (/(length lst1)2)
    
37.    (repeat 2
    
38.     (setq  dxf10 (nth n lst1))
    
39.     (setq fglst1 (append fglst1 (list dxf10 )))
    
40.     (setq n (1+ n))
    
41.     )
    
42.   (setq fglst (append  fglst (list fglst1 )))
    
43.   (setq fglst1 nil)
    
44.   (setq i(1+ i))
    
45.   )
    
46.   )

defun c:pxlj(/ e1 e2 vla_e1 vla_e2 pts1 pts2 fglst lst_dist&p)<br />   (setq e1(car(entsel"\n 选择第一条曲线："))<br />   e2(car(entsel"\n 选择第二条曲线："))<br />   vla_e1(vlax-ename->vla-object e1)<br />   vla_e2(vlax-ename->vla-object e2)<br />   pts1(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e1)))<br />   pts2(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e2)))<br />   )<br />   (fgb pts1)<br />   (setq pts1 fglst fglst nil)<br />   (fgb pts2)<br />   (setq pts2 fglst fglst nil)<br />   (setq i 0 m 0)<br />   (while(< i(length  pts1))<br />      (setq x (nth i pts1))<br />      (while (< m(length  pts2))<br />        (setq y (nth m pts2))<br /> <br />        (setq lst_dist&p (append lst_dist&p (list(list x y (distance x y)))))<br />        (setq m(1+ m))<br />         )<br />     (setq lst_dist&p(vl-sort lst_dist&p(function(lambda(x1 x2)(< (caddr x1)(caddr x2))))))<br />     (command "line" (caar lst_dist&p)(cadar lst_dist&p) "")<br />     (setq pts1(vl-remove (caar lst_dist&p) pts1)<br />     pts2(vl-remove (cadar lst_dist&p) pts2)<br />     )<br />     (setq lst_dist&p nil)<br />     (if(not  pts1)(setq i (1+ i)))<br />     (if(not  pts2)(setq m (1+ m))(setq m 0))<br />      )<br />   )<br />     <br /> ;;;;;;;;;;;;;;;;;;;;;;;;;;;将表内元素每2个进行分割重新组表;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun fgb(lst1 / fglst1 dxf10 n)<br /> (setq n 0 i 0)<br /> (repeat (/(length lst1)2)<br />    (repeat 2<br />     (setq  dxf10 (nth n lst1))<br />     (setq fglst1 (append fglst1 (list dxf10 )))<br />     (setq n (1+ n))<br />     )<br />   (setq fglst (append  fglst (list fglst1 )))<br />   (setq fglst1 nil)<br />   (setq i(1+ i))<br />   )<br />   )

xyp1964

2. ;; 云共享 [url]http://yunpan.cn/QXQKsW9gAPmpF[/url](defun c:tt (/ ss s1 s2)
   
3.   (if (setq ss (ssget '((0 . "*polyline"))))
   
4.     (progn
   
5.       (setq i -1)
   
6.       (while (and (setq s1 (ssname ss (setq i (1+ i))))
   
7.                   (setq s2 (ssname ss (1+ i)))
   
8.              )
   
9.         (xyp-line (xyp-get-Vertexs s1 0) (xyp-get-Vertexs s2 0))
   
10.       )
    
11.     )
    
12.   )
    
13.   (princ)
    
14. )

;; 云共享 [url]http://yunpan.cn/QXQKsW9gAPmpF[/url](defun c:tt (/ ss s1 s2)<br />   (if (setq ss (ssget '((0 . "*polyline"))))<br />     (progn<br />       (setq i -1)<br />       (while (and (setq s1 (ssname ss (setq i (1+ i))))<br />                   (setq s2 (ssname ss (1+ i)))<br />              )<br />         (xyp-line (xyp-get-Vertexs s1 0) (xyp-get-Vertexs s2 0))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

gwpgc

谢谢 xyp1964
加载运行后显示“no function definition: XYP-GET-VERTEXS”，怎么解决？

水仙的错

e派工具箱最新哪里有下载？

水仙的错

问题还是没有解决啊

水仙的错

期待哪个高手能做框选链接

3625095

期待哪个高手能做框选链接