请求功能完善线段之间增加线连接

434939575

本程序想要达到最右边的连线效果，颜色不要那样子[em0]。自己只能弄出中间的效果。望大家多多帮助。谢谢！

2. 
   
3. 
   
4. (defun  c:tt()
   
5. 
   
6. (setq ss(ssget))
   
7. (tmp_2 ss)
   
8.   )
   
9. 
   
10. ;;; 功能  水平线端点增线连线
    
11. (defun tmp_2 (ss / one_pt:ab pt_jion sort_y<  two_pt:a two_pt:ab)
    
12.   (setq lis_app nil)
    
13.     (setq sort_y< (tmp_1 ss))
    
14.      ;(setq pa (cadar sort_y<));第一点
    
15.   (while (/= sort_y< nil)
    
16.     (setq one_pt:ab (cdar sort_y<))
    
17.     (setq two_pt:ab (reverse (cdadr sort_y<)))
    
18.     (setq two_pt:a (car two_pt:ab))
    
19.     (setq two_pt:a (cadr two_pt:ab))
    
20.     (if  (/= pt_jion nil)
    
21.       (progn
    
22.   (if (/= two_pt:a nil)
    
23.     (setq  lis> (list pt_jion
    
24.          (car one_pt:ab)
    
25.          (cadr one_pt:ab)
    
26.          (car two_pt:ab)
    
27.          (cadr two_pt:ab)
    
28.          )
    
29.     )
    
30.     (setq lis> (list pt_jion (car one_pt:ab) (cadr one_pt:ab)))
    
31.   ) ;if
    
32.       ) ;progn <<
    
33.       (progn (if (/= two_pt:a nil)
    
34.          (setq lis> (list  (car one_pt:ab)
    
35.         (cadr one_pt:ab)
    
36.         (car two_pt:ab)
    
37.         (cadr two_pt:ab)
    
38.         )
    
39.          )
    
40.          (setq lis> (list (car one_pt:ab) (cadr one_pt:ab)))
    
41.        ) ;if
    
42.       ) ;progn <<
    
43.     ) ;if
    
44.     (setq sort_y< (cddr sort_y<))
    
45.     (setq pt_jion two_pt:a)
    
46.     (setq lis_app (append lis_app lis>))
    
47.   )  ;while
    
48.   (entmake_pline lis_app)
    
49. )    ;end
    
50. 
    
51. ;;;********************************
    
52. (defun entmake_pline (lst)
    
53.   (entmake (append (list '(0 . "LWPOLYLINE")
    
54.        '(100 . "AcDbEntity")
    
55.        '(100 . "AcDbPolyline")
    
56.        (cons 90 (length lst))
    
57.        )
    
58.        (mapcar '(lambda (pt) (cons 10 pt)) lst)
    
59.      )
    
60.   )
    
61. )
    
62. 
    
63. 
    
64. ;;水平线-名字 2端点 从下到上排序
    
65. (defun tmp_1 (ss       /
    
66.                  e1       e2
    
67.                  ii       na+pt>ab
    
68.                  na+pt>ab+
    
69.                  name    pt_lis
    
70.                  pta     pta_x
    
71.                  ptb     ptb_x
    
72.                  vl_y<
    
73.                 )
    
74.   (setq na+pt>ab+ nil)
    
75.   (setq ii 0)
    
76.   (repeat (sslength ss)
    
77.     (setq name (ssname ss ii)
    
78.     ii   (1+ ii)
    
79.     )
    
80.     (setq pta (vlax-curve-getstartpoint name))
    
81.     (setq ptb (vlax-curve-getendpoint name))
    
82.     (setq pta_x (car pta))
    
83.     (setq ptb_x (car ptb))
    
84.     (if  (< pta_x ptb_x) ;水平线排序
    
85.       (setq pt_lis (list pta ptb))
    
86.       (setq pt_lis (list ptb pta))
    
87.     )
    
88.     (setq na+pt>ab (append (list name) pt_lis))
    
89.     (setq na+pt>ab+ (append (list na+pt>ab) na+pt>ab+))
    
90.   )  ;repeat
    
91.   (setq
    
92.     vl_y< (vl-sort
    
93.       na+pt>ab+
    
94.       (function (lambda (e1 e2) (< (cadadr e1) (cadadr e2))))
    
95.     )
    
96.   )
    
97. )    ;end
    
98. 
    
99. 
    

<br /> <br /> (defun  c:tt()<br /> <br /> (setq ss(ssget))<br /> (tmp_2 ss)<br />   )<br /> <br /> ;;; 功能  水平线端点增线连线<br /> (defun tmp_2 (ss / one_pt:ab pt_jion sort_y<  two_pt:a two_pt:ab)<br />   (setq lis_app nil)<br />     (setq sort_y< (tmp_1 ss))<br />      ;(setq pa (cadar sort_y<));第一点<br />   (while (/= sort_y< nil)<br />     (setq one_pt:ab (cdar sort_y<))<br />     (setq two_pt:ab (reverse (cdadr sort_y<)))<br />     (setq two_pt:a (car two_pt:ab))<br />     (setq two_pt:a (cadr two_pt:ab))<br />     (if  (/= pt_jion nil)<br />       (progn<br />   (if (/= two_pt:a nil)<br />     (setq  lis> (list pt_jion<br />          (car one_pt:ab)<br />          (cadr one_pt:ab)<br />          (car two_pt:ab)<br />          (cadr two_pt:ab)<br />          )<br />     )<br />     (setq lis> (list pt_jion (car one_pt:ab) (cadr one_pt:ab)))<br />   ) ;if<br />       ) ;progn <<<br />       (progn (if (/= two_pt:a nil)<br />          (setq lis> (list  (car one_pt:ab)<br />         (cadr one_pt:ab)<br />         (car two_pt:ab)<br />         (cadr two_pt:ab)<br />         )<br />          )<br />          (setq lis> (list (car one_pt:ab) (cadr one_pt:ab)))<br />        ) ;if<br />       ) ;progn <<<br />     ) ;if<br />     (setq sort_y< (cddr sort_y<))<br />     (setq pt_jion two_pt:a)<br />     (setq lis_app (append lis_app lis>))<br />   )  ;while<br />   (entmake_pline lis_app)<br /> )    ;end<br /> <br /> ;;;********************************<br /> (defun entmake_pline (lst)<br />   (entmake (append (list '(0 . "LWPOLYLINE")<br />        '(100 . "AcDbEntity")<br />        '(100 . "AcDbPolyline")<br />        (cons 90 (length lst))<br />        )<br />        (mapcar '(lambda (pt) (cons 10 pt)) lst)<br />      )<br />   )<br /> )<br /> <br /> <br /> ;;水平线-名字 2端点 从下到上排序<br /> (defun tmp_1 (ss       /<br />                  e1       e2<br />                  ii       na+pt>ab<br />                  na+pt>ab+<br />                  name    pt_lis<br />                  pta     pta_x<br />                  ptb     ptb_x<br />                  vl_y<<br />                 )<br />   (setq na+pt>ab+ nil)<br />   (setq ii 0)<br />   (repeat (sslength ss)<br />     (setq name (ssname ss ii)<br />     ii   (1+ ii)<br />     )<br />     (setq pta (vlax-curve-getstartpoint name))<br />     (setq ptb (vlax-curve-getendpoint name))<br />     (setq pta_x (car pta))<br />     (setq ptb_x (car ptb))<br />     (if  (< pta_x ptb_x) ;水平线排序<br />       (setq pt_lis (list pta ptb))<br />       (setq pt_lis (list ptb pta))<br />     )<br />     (setq na+pt>ab (append (list name) pt_lis))<br />     (setq na+pt>ab+ (append (list na+pt>ab) na+pt>ab+))<br />   )  ;repeat<br />   (setq<br />     vl_y< (vl-sort<br />       na+pt>ab+<br />       (function (lambda (e1 e2) (< (cadadr e1) (cadadr e2))))<br />     )<br />   )<br /> )    ;end<br /> <br /> <br />

llsheng_73

没有仔细看你是怎么做到中间这个图的结果的，只是比较了中间和右边两个图的区别，要做到最右边的结果
个人认为可以在你目前能做出中间图的基础上按下边的方法进行处理
选出所有待处理线段(按y坐标从小至大排序)
（while 待处理线段表非空
  从第一条线段开始处理
  (如果该线段与第二条线段端点间距离过大，不进行连接处理，否则进行连接)
   (将处理过的线段从待处理线段中去掉)
）

hehoubin

处理到第3个的可能性很小。

77077

可不可以将直线按长度分组呢？

434939575

77077 发表于 2015-8-3 09:50
可不可以将直线按长度分组呢？

分组倒是可以，我还处理不好