等高线光滑与过滤.docVIP

等高线的光滑与过滤 王海超 郑先东 文章摘要: 在Cass软件有拟合与过滤功能但不能达到我们所要的效果，因此作者想到了另一种处理算法，下面我们来阐述这种算法。文章关键词: 过滤。 等高线的光滑：光滑等高线有两个要求，第一是要保持等高线的原来位置不变，第二是不能有尖角。这是两个相互矛盾的要求，要满足这两个要求我们需要分两步走： 第一步：例如图1所示，我们还从等高线的当前点出发,设当前点为n,第二个点n+1,第三点n+2, 设n点坐标X0,Y0;设n+1的坐标为X1,Y1; 设n+2的坐标为X2,Y2;要把n+1点处的尖角去掉，取a边和b边中距离短的一边的四分之一(Dis)，用这个距离作为参数求出n+1点附近处的两个点n+3,n+4。设n+3的坐标为X3,Y3;设n+4的坐标为X4,Y4.求n+3,n+4点坐标的公式如下： X3=X0+(X1-X0)*dis/a Y3=Y0+(Y1-Y0)*dis/a X4=X2+(X1-X2)*dis/b Y4=Y2+(Y1-Y2)*dis/b 图1 图2 说明一下：图2为去除尖角后的图，上面的“1/4”是个参数，作者在几次试验后发现用这个参数比较合理，既可以去掉尖角又不致超过限差的改变等高线的位置。在使用过程中我们可以多次使用此步，让等高线变得比较光滑。 第二步：使用3次B样拟合公式对等高线进行拟合处理，设等高线上的当前点为n，拟合公式为： T为小于等于1的参数，计算公式为:i/m,其中”i”为从”0”到”m”的变量，”m”为要添加的节点数目。 Px为横坐标点数组，Py为纵坐标点数组。 x,y为光滑后的等高线上的节点坐标。 上面的算法已用程序实现，以下为主要部分源代码： Sub CreateFittingLine() Dim Sset As AcadSelectionSet Dim filterType(0) As Integer Dim filterData(0) As Variant filterType(0) = 0 filterData(0) = *line On Error Resume Next If Not IsNull(ThisDrawing.SelectionSets.Item(Example)) Then Set Sset = ThisDrawing.SelectionSets.Item(Example) Sset.Delete End If Set Sset = ThisDrawing.SelectionSets.Add(Example) Sset.SelectOnScreen filterType, filterData Dim Obj As AcadEntity Dim k As Integer Dim a0, a1, a2, a3 As Integer 几个在闭合曲线中使用的参数 For k = 0 To Sset.count - 1 Set Obj = Sset.Item(k) 3次B样拟合算法 Dim Px() As Double Dim Py() As Double Dim i, j, m, n As Integer Dim T As Double Dim f0, f1, f2, f3 As Double Dim x, y As Double Dim gc As Long 等高线的高程 m = GetVertexCount(Obj) - 1 Dim Zb1() As Double Dim Zb2() As Double ReDim Zb1(2 * m + 1) As Double For i = 0 To m Zb1(2 * i) = Obj.Coordinate(i)(0) Zb1(2 * i + 1) = Obj.Coordinate(i)(1) Next i Call changeOneRoleToFour(Zb1, Zb2) 去除距离太近的点‘可以通过改变此函数中的距离参数来提高线的圆滑，可是有可能照成点线不一。把尖角变成4个角 m = (UBound(Zb2) + 1) / 2 - 1 现在有m+1个点 ReDim Px(m) As Double ReDim Py(m) As Double For i = 0 To m Px(i)