phoenixdjq
发表于 2009-2-11 09:00:00
<p>因为文件格式不对，压缩后就能上传了</p>
dzt
发表于 2009-3-5 22:22:00
<p>我也试了，的确黑白间隔不等，而且拟合后，有些白色的框框数量减少，导致黑白间隔差距更大，这到底为什么？能有更好的处理方法吗？</p>
dianbotang
发表于 2009-4-5 01:34:00
<p>绘制铁路线的vba程序，适用于将多条多段线转为铁路线，有兴趣的朋友可以据此改进满足自身需要。</p><p>对于样条曲线，直线和圆弧，可以先转为多段线。</p><p>Option Explicit<br/>'绘制铁路线<br/>Sub Railway()<br/> On Error GoTo ErrorHandler</p><p> Dim SSet As AcadSelectionSet<br/> Set SSet = ThisDrawing.PickfirstSelectionSet<br/> If SSet.Count = 0 Then<br/> MsgBox "未选择对象"<br/> Exit Sub<br/> End If<br/> <br/> AppActivate ThisDrawing.Application.Caption<br/> Dim Width As Double<br/> Width = ThisDrawing.Utility.GetReal(vbLf & "请输入铁路线宽: ")<br/> Dim currLTScale As Double<br/> currLTScale = ThisDrawing.Utility.GetReal(vbLf & "请输入铁路线型比例: ")<br/> Dim currLinetype As String<br/> currLinetype = ThisDrawing.Utility.GetString(False, vbLf & "请输入铁路线型: ")<br/> <br/> Dim entry As AcadLineType<br/> Dim found As Boolean<br/> found = False<br/> For Each entry In ThisDrawing.Linetypes<br/> If StrComp(entry.Name, currLinetype, 1) = 0 Then<br/> found = True<br/> Exit For<br/> End If<br/> Next<br/> If Not (found) Then ThisDrawing.Linetypes.Load currLinetype, "acad.lin"</p><p> Dim PlineObj As AcadEntity<br/> Dim OffsetObj1 As Variant<br/> Dim OffsetObj2 As Variant<br/> For Each PlineObj In SSet<br/> If TypeName(PlineObj) Like "IAcad*Polyline" Then<br/> OffsetObj1 = PlineObj.Offset(Width / 2)<br/> OffsetObj2 = PlineObj.Offset(-Width / 2)<br/> PlineObj.ConstantWidth = Width<br/> PlineObj.LinetypeScale = currLTScale<br/> PlineObj.Linetype = currLinetype<br/> PlineObj.LinetypeGeneration = True<br/> End If<br/> Next<br/> ThisDrawing.Regen True<br/> Exit Sub<br/> <br/>ErrorHandler:<br/> MsgBox Err.Description<br/> <br/>End Sub<br/></p>