[编程申请]：有没有把短线合成长线的工具

god

我收到一张dwg图纸，他们故意把一条多义线打断成很多短线段，本来是几百K的小文件变成了十几兆的大文件，给下一步的工作增加了麻烦，请问有没有什么办法把它合成端点较少的多义线呢？

急急急

******************************************
斑竹评论：能够引导大家积极讨论，有助于学习交流。

eachy

最初由 god 发布
[B]我收到一张dwg图纸，他们故意把一条多义线打断成很多短线段，本来是几百K的小文件变成了十几兆的大文件，给下一步的工作增加了麻烦，请问有没有什么办法把它合成端点较少的多义线呢？

急急急 [/B]

工具箱－》曲线－》线变复线

god

没有啊，我用的是026版的xdbox

XDSoft

最初由 god 发布
[B]没有啊，我用的是026版的xdbox [/B]

屏幕菜单：

曲线－线变复线，能把首尾相连的LINE,ARC,POLYLINE连接成一个POLYLINE。

god

仅仅连接还不行，因为它本来就是连起来的，我想把几乎位于一条直线上的多段线连成一根直线，这样既不影响图纸效果，也可减小图的大小

eachy

那用连接线段

efan2000

最初由 god 发布
[B]没有啊，我用的是026版的xdbox [/B]

god

我猜你指的是“连接线段”“合并线段”吧，

看看他们提交的图。中间那根线上的夹点，密密麻麻的。度量太小了。

没必要这么密的，我想把他们变成只有几个端点的线

efan2000

可否把这条线拷贝到另一张图纸，上传上来，大家帮忙解决一下。

god

是一张地形图，我们要在上面做工程。但是文件有30多兆，我删了一些东西，还有十几兆。这是很小的局部图。可以看出效果

wang_yangming

调用方法：I级钢筋％％130，II级钢筋％％131，III级钢筋％％132，IV级钢筋％％133

god

我不是要联结啦，我是要减少一根多义线的端点数啦

看他们画的圆，都断成几百个端点的多义线了。

请大家伙儿帮忙看看，咋办呢？

各位斑竹，是不是暂时没办法了？

XDSoft

最初由 god 发布
[B]我不是要联结啦，我是要减少一根多义线的端点数啦

看他们画的圆，都断成几百个端点的多义线了。

请大家伙儿帮忙看看，咋办呢？

各位斑竹，是不是暂时没办法了？ [/B]

不明白你的意思，用那个工具，几百个断的线，就连成一个了。

如果你说的还是一根，被人为的里面多了几百个端点，我想没有人能做到吧。

efan2000

其实就是多段线的顶点太密了，下面的例程是用R2000r的VBA作的，大家可以把它转换成其它语言的。目的是把线中每隔几点的之间的顶点去除。

2. 
   
3.   [FONT=courier new]
   
4. Sub Test()
   
5.     Dim EntObj As AcadEntity
   
6.     Dim vPt As Variant
   
7.     Dim i As Integer
   
8.     For Each EntObj In ThisDrawing.ModelSpace
   
9.         If TypeOf EntObj Is AcadLWPolyline Then
   
10.             vPt = EntObj.Coordinates
    
11.             For i = 0 To UBound(vPt) Step 2
    
12.                 If i Mod 5 <> 0 Then '每隔5点，去除中间的4个点
    
13.                     RemoveVertex EntObj, i / 2
    
14.                 End If
    
15.             Next
    
16.         End If
    
17.     Next
    
18. End Sub
    
19. 
    
20. '删除多段线中的某一个顶点
    
21. Sub RemoveVertex(ByRef pLineObj As AcadLWPolyline, ByVal Index As Integer)
    
22.     Dim vPt As Variant
    
23.     Dim Pt() As Double
    
24.     vPt = pLineObj.Coordinates
    
25.     If Index > (UBound(vPt) - 1) / 2 Then Exit Sub
    
26.     ReDim Pt(0 To UBound(vPt) - 2)
    
27.     Dim i As Integer
    
28.     For i = 0 To UBound(vPt) - 2 Step 2
    
29.         If i / 2 >= Index Then
    
30.             Pt(i) = vPt(i + 2)
    
31.             Pt(i + 1) = vPt(i + 3)
    
32.         Else
    
33.             Pt(i) = vPt(i)
    
34.             Pt(i + 1) = vPt(i + 1)
    
35.         End If
    
36.     Next
    
37.     pLineObj.Coordinates = Pt
    
38. End Sub
    
39.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Test()<br />     Dim EntObj As AcadEntity<br />     Dim vPt As Variant<br />     Dim i As Integer<br />     For Each EntObj In ThisDrawing.ModelSpace<br />         If TypeOf EntObj Is AcadLWPolyline Then<br />             vPt = EntObj.Coordinates<br />             For i = 0 To UBound(vPt) Step 2<br />                 If i Mod 5 <> 0 Then '每隔5点，去除中间的4个点<br />                     RemoveVertex EntObj, i / 2<br />                 End If<br />             Next<br />         End If<br />     Next<br /> End Sub<br /> <br /> '删除多段线中的某一个顶点<br /> Sub RemoveVertex(ByRef pLineObj As AcadLWPolyline, ByVal Index As Integer)<br />     Dim vPt As Variant<br />     Dim Pt() As Double<br />     vPt = pLineObj.Coordinates<br />     If Index > (UBound(vPt) - 1) / 2 Then Exit Sub<br />     ReDim Pt(0 To UBound(vPt) - 2)<br />     Dim i As Integer<br />     For i = 0 To UBound(vPt) - 2 Step 2<br />         If i / 2 >= Index Then<br />             Pt(i) = vPt(i + 2)<br />             Pt(i + 1) = vPt(i + 3)<br />         Else<br />             Pt(i) = vPt(i)<br />             Pt(i + 1) = vPt(i + 1)<br />         End If<br />     Next<br />     pLineObj.Coordinates = Pt<br /> End Sub<br />   [/FONT]<br />

aeo

是地形图呀
扫描后矢量化的,都这样的
真有好办法就好了