【已解决】多段线的顶点连线

■D_zZ

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

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. 
    
20.        (setq lst_dist&p (append lst_dist&p (list(list x y (distance x y)))))
    
21.        (setq m(1+ m))
    
22.         )
    
23.     (setq lst_dist&p(vl-sort lst_dist&p(function(lambda(x1 x2)(< (caddr x1)(caddr x2))))))
    
24.     (command "line" (caar lst_dist&p)(cadar lst_dist&p) "")
    
25.     (setq pts1(vl-remove (caar lst_dist&p) pts1)
    
26.     pts2(vl-remove (cadar lst_dist&p) pts2)
    
27.     )
    
28.     (setq lst_dist&p nil)
    
29.     (if(not  pts1)(setq i (1+ i)))
    
30.     (if(not  pts2)(setq m (1+ m))(setq m 0))
    
31.      )
    
32.   )
    
33.    
    
34. ;;;;;;;;;;;;;;;;;;;;;;;;;;;将表内元素每2个进行分割重新组表;;;;;;;;;;;;;;;;;;;;;;;;;
    
35. (defun fgb(lst1 / fglst1 dxf10 n)
    
36. (setq n 0 i 0)
    
37. (repeat (/(length lst1)2)
    
38.    (repeat 2
    
39.     (setq  dxf10 (nth n lst1))
    
40.     (setq fglst1 (append fglst1 (list dxf10 )))
    
41.     (setq n (1+ n))
    
42.     )
    
43.   (setq fglst (append  fglst (list fglst1 )))
    
44.   (setq fglst1 nil)
    
45.   (setq i(1+ i))
    
46.   )
    
47.   )

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 />   )

st788796

顶点数不等呢?
多选后怎么确定哪两个连接?

newer

是啊，多选后，哪个和哪个连接呢？

■D_zZ

都是平行线的顶点，点数是相等的，实际是两根偏移的多段线

st788796

把点两次改为点两个点ssget?

守仁格竹GM

应该是适用于 类似偏移后的 等数量 等顺序两条线

st788796

守仁格竹GM 发表于 2013-11-1 12:42
应该是适用于 类似偏移后的 等数量 等顺序两条线

这就没必要了，都是点两次

■D_zZ

最好是一次性框选

st788796

■D_zZ 发表于 2013-11-1 19:11
最好是一次性框选

你要框选多少个呢?

1. (defun c:tt (/ ss el)
   
2.   (if (and (setq ss (ssget '((0 . "lwpolyline"))))
   
3.     (= (sslength ss) 2)
   
4.       )
   
5.     (progn
   
6.       (setq el (xdrx_pickset->ents ss))
   
7.       (mapcar '(lambda (x y)
   
8.    (xdrx_line_make x y)
   
9.         )
   
10.        (xdrx_entity_getstretchpoint (car el))
    
11.        (xdrx_entity_getstretchpoint (cadr el))
    
12.       )
    
13.     )
    
14.   )
    
15.   (princ)
    
16. )

(defun c:tt (/ ss el)<br />   (if (and (setq ss (ssget '((0 . "lwpolyline"))))<br />     (= (sslength ss) 2)<br />       )<br />     (progn<br />       (setq el (xdrx_pickset->ents ss))<br />       (mapcar '(lambda (x y)<br />    (xdrx_line_make x y)<br />         )<br />        (xdrx_entity_getstretchpoint (car el))<br />        (xdrx_entity_getstretchpoint (cadr el))<br />       )<br />     )<br />   )<br />   (princ)<br /> )

st788796

Lisp 的这样

1. (defun c:tt (/ ss)
   
2.   (if (and (setq ss (ssget '((0 . "lwpolyline"))))
   
3.     (= (sslength ss) 2)
   
4.       )
   
5.     (mapcar '(lambda (x y)
   
6.         (entmake (list '(0 . "LINE")
   
7.          '(100 . "AdDbEntity")
   
8.          '(100 . "AcDbLine")
   
9.          x
   
10.          (cons 11 (cdr y))
    
11.    )
    
12.         )
    
13.       )
    
14.      (vl-remove-if-not
    
15.        '(lambda (x) (= (car x) 10))
    
16.        (entget (ssname ss 0))
    
17.      )
    
18.      (vl-remove-if-not
    
19.        '(lambda (x) (= (car x) 10))
    
20.        (entget (ssname ss 1))
    
21.      )
    
22.     )
    
23.   )
    
24.   (princ)
    
25. )

(defun c:tt (/ ss)<br />   (if (and (setq ss (ssget '((0 . "lwpolyline"))))<br />     (= (sslength ss) 2)<br />       )<br />     (mapcar '(lambda (x y)<br />         (entmake (list '(0 . "LINE")<br />          '(100 . "AdDbEntity")<br />          '(100 . "AcDbLine")<br />          x<br />          (cons 11 (cdr y))<br />    )<br />         )<br />       )<br />      (vl-remove-if-not<br />        '(lambda (x) (= (car x) 10))<br />        (entget (ssname ss 0))<br />      )<br />      (vl-remove-if-not<br />        '(lambda (x) (= (car x) 10))<br />        (entget (ssname ss 1))<br />      )<br />     )<br />   )<br />   (princ)<br /> )

■D_zZ

大功告成，谢谢 st788796 {:soso_e163:}

xinyeyu

用了没有效果，根本没有连线连起来