平行的多段线顶点相连

10410024

哪位高手能否编一个程序解决两条平行的多段线顶点相连问题啊。。如图所示。求助！

水仙的错

能框选就完美了，哪位大师弥补下

tianbeiyuan

很实用的程序啊正需要

水仙的错

源码用不了

yan19851204

求助版主！

yjr111

2. (defun c:pxlj(/ e1 e2 vla_e1 vla_e2 pts1 pts2 fglst lst_dist&p)
   
3.   (setq e1(car(entsel"\n 选择第一条曲线："))
   
4.   e2(car(entsel"\n 选择第二条曲线："))
   
5.   vla_e1(vlax-ename->vla-object e1)
   
6.   vla_e2(vlax-ename->vla-object e2)
   
7.   pts1(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e1)))
   
8.   pts2(vlax-safearray->list(vlax-variant-value(vla-get-coordinates vla_e2)))
   
9.   )
   
10.   (fgb pts1)
    
11.   (setq pts1 fglst fglst nil)
    
12.   (fgb pts2)
    
13.   (setq pts2 fglst fglst nil)
    
14.   (setq i 0 m 0)
    
15.   (while(< i(length  pts1))
    
16.      (setq x (nth i pts1))
    
17.      (while (< m(length  pts2))
    
18.        (setq y (nth m pts2))
    
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 />        (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 />   )<br />

yan19851204

yjr111 发表于 2011-12-15 12:03

高手，谢谢！

yoyoho

程序实用学习了!

daidong013

yjr111 发表于 2011-12-15 12:03

朋友：改成框选的吧！更快捷！~~呵呵！~~

T_T

很实用的程序谢谢

xingyun300

是，能框选就好了！大侠，再改改呗！还有，能不能选择直线呢？不是平行的直线能完成这样的操作吗？

xingyun300

顶上去，请高手改为框选！

vlisp2012

在论坛收集后整理的3p线对应顶点连线程序。