请帮忙修改连接同向且接近的短线

434939575

请教各位朋友：
我的目的。连接相同方向的线，且(基本没有间距)的线。
我的想法。是全部选择构建选择集：aa  
再提取选择集里面第一个图元，按线方向两头（根据自己情况）定距离选择。把同向的，和相交的选择了
再把不同向的过滤掉。最后连接。
再把原来选择集AA 减去刚才的选择集。
这样循环。现在循环条件设置不对，

2. (defun c:tt ()
   
3.   (vl-load-com)
   
4.   (setq ss_all (ssget '((0 . "line"))))
   
5.    (while  
   
6.     (/= 0 (sslength ss_all) )
   
7.   (setq name_00 (ssname ss_all 0))
   
8.   (setq pt:start (vlax-curve-getstartpoint name_00))
   
9.   (setq pt:end (vlax-curve-getendpoint name_00))
   
10.   (setq ang_00 (angle pt:start pt:end))
    
11.   (setq lengt++ 100000) ;测试过程由于数据过小引起失误
    
12.   (setq pt<--- (polar pt:start (angle pt:end pt:start) lengt++))
    
13.   (setq pt---> (polar pt:end (angle pt:start pt:end) lengt++))
    
14.   (setq lis (list pt<--- pt--->))
    
15.   (setq ss>>1 (ssget "f" lis '((0 . "*line"))))
    
16. ;;;;----------------------
    
17.   (setq ii 0)
    
18.   (setq add_11 (ssadd))
    
19.   (repeat (sslength ss>>1)
    
20.     (setq name>11 (ssname ss>>1 ii)
    
21.     ii    (1+ ii)
    
22.     )
    
23.     (setq start>11 (vlax-curve-getstartpoint name>11))
    
24.     (setq end>11 (vlax-curve-getendpoint name>11))
    
25.     (setq ang>11 (angle start>11 end>11))
    
26.     (if   ;把与第一个图元角度（ang_00）相等的分类到选择集add_11
    
27.       (or (= ang_00 ang>11) (= ang_00 (+ pi ang>11)))
    
28. 
    
29.       (progn
    
30.        (setq add_11 (ssadd name>11 add_11))
    
31.        (setq ss>nub_11 (sslength add_11))
    
32.        );progn
    
33.     ) ;if
    
34.   ) ;repeat
    
35. ;;;;----------------------
    
36.   (setq ss>nub (sslength ss>>1))
    
37.   (command "_.select" ss_all "r" add_11 "")
    
38.   (setq ss_all (ssget "p")) ;设置
    
39.   (setq ss>nub (sslength ss_all))
    
40.    ;(sssetfirst nil xx)
    
41.   (vl-cmdf "pedit" "m" add_11 "" "y" "j" 1 "")
    
42.   ) ;while
    
43. )

(defun c:tt ()<br />   (vl-load-com)<br />   (setq ss_all (ssget '((0 . "line"))))<br />    (while  <br />     (/= 0 (sslength ss_all) )<br />   (setq name_00 (ssname ss_all 0))<br />   (setq pt:start (vlax-curve-getstartpoint name_00))<br />   (setq pt:end (vlax-curve-getendpoint name_00))<br />   (setq ang_00 (angle pt:start pt:end))<br />   (setq lengt++ 100000) ;测试过程由于数据过小引起失误<br />   (setq pt<--- (polar pt:start (angle pt:end pt:start) lengt++))<br />   (setq pt---> (polar pt:end (angle pt:start pt:end) lengt++))<br />   (setq lis (list pt<--- pt--->))<br />   (setq ss>>1 (ssget "f" lis '((0 . "*line"))))<br /> ;;;;----------------------<br />   (setq ii 0)<br />   (setq add_11 (ssadd))<br />   (repeat (sslength ss>>1)<br />     (setq name>11 (ssname ss>>1 ii)<br />     ii    (1+ ii)<br />     )<br />     (setq start>11 (vlax-curve-getstartpoint name>11))<br />     (setq end>11 (vlax-curve-getendpoint name>11))<br />     (setq ang>11 (angle start>11 end>11))<br />     (if   ;把与第一个图元角度（ang_00）相等的分类到选择集add_11<br />       (or (= ang_00 ang>11) (= ang_00 (+ pi ang>11)))<br /> <br />       (progn<br />        (setq add_11 (ssadd name>11 add_11))<br />        (setq ss>nub_11 (sslength add_11))<br />        );progn<br />     ) ;if<br />   ) ;repeat<br /> ;;;;----------------------<br />   (setq ss>nub (sslength ss>>1))<br />   (command "_.select" ss_all "r" add_11 "")<br />   (setq ss_all (ssget "p")) ;设置<br />   (setq ss>nub (sslength ss_all))<br />    ;(sssetfirst nil xx)<br />   (vl-cmdf "pedit" "m" add_11 "" "y" "j" 1 "")<br />   ) ;while<br /> )

荒野孤行

那不就是删除重线的功能么？

434939575

荒野孤行 发表于 2015-3-21 23:27
那不就是删除重线的功能么？

谢谢关照。确实是的。

荒野孤行

434939575 发表于 2015-3-22 10:35
谢谢关照。确实是的。

搞定了吧？

434939575

嗯，网上搜了去重线，就可以了，谢谢啦！