自动处理缝隙错误运行不了

<P>我在海阔天空的个人博客看到以下一段代码，请看一下怎么运行不了，是不是要在VB下编译成DLL文件。</P>
<DIV class=tit>ArcGIS Topology——自动处理细小缝隙</DIV>
<DIV class=date>2008年07月14日 星期一 10:04</DIV>
<P>
<TABLE >

<TR>
<TD>
<DIV>
<P>'//处理之前一定需要对要素进行Repaire，去除空几何对象要素</P>
<br>
<p>
<P>Private Sub ValidateGaps(ByVal pTopology As ITopology)<BR>    Dim pTopoErrCon As IErrorFeatureContainer<BR>    Set pTopoErrCon = pTopology<BR>    Dim pEnumtopoErrorFeature As IEnumTopologyErrorFeature<BR>    Dim pTopoRuleCon As ITopologyRuleContainer<BR>    Set pTopoRuleCon = pTopology<BR>    Dim pTopologyRule As ITopologyRule<BR>    Dim pFeatureClass As IFeatureClass<BR>    Dim pDs As IDataset<BR>    Dim pFeatureWs As IFeatureWorkspace<BR>    Set pDs = pTopology<BR>    Set pFeatureWs = pDs.Workspace<BR>    '//某图层<BR>    Set pFeatureClass = pFeatureWs.OpenFeatureClass(g_TOPOFCName)<BR>    If pFeatureClass Is Nothing Then Exit Sub<BR>    Dim pEnumRule As IEnumRule<BR>    Set pEnumRule = pTopoRuleCon.RulesByClass(pFeatureClass.FeatureClassID)<BR>    pEnumRule.Reset<BR>    Set pTopologyRule = pEnumRule.Next<BR>    Do While Not pTopologyRule Is Nothing<BR>        If pTopologyRule.TopologyRuleType = esriTRTAreaNoGaps Then Exit Do<BR>        Set pTopologyRule = pEnumRule.Next<BR>    Loop<BR>    If pTopologyRule Is Nothing Then Exit Sub<BR>    '//获得JZM不能自相重叠的拓扑错误<BR>    Dim pGeoDs As IGeoDataset<BR>    Set pGeoDs = pFeatureClass<BR>    Set pEnumtopoErrorFeature = pTopoErrCon.ErrorFeatures(pGeoDs.SpatialReference, pTopologyRule, pGeoDs.Extent, True, False)<BR>    Dim pTopoErrorFeature As ITopologyErrorFeature<BR>    Set pTopoErrorFeature = pEnumtopoErrorFeature.Next<BR>    Dim pFeature As IFeature<BR>    '//拓扑错误的相关要素<BR>    Dim pSFeature As IFeature<BR>    Dim pDFeature As IFeature<BR>    Dim pArea1 As IArea<BR>    Dim pArea2 As IArea<BR>    Dim pArea3 As IArea<BR>    Dim lFldZDH As Long '//宗地号<BR>    Dim lFldJSZDMJ As Long '//计算宗地面积<BR>    lFldZDH = pFeatureClass.FindField("zdh")<BR>    Dim lFldSJYT As Long<BR>    If lFldZDH < 0 Then<BR>        MsgBox "没有发现关键字段:宗地号或者土地实际用途", vbInformation, "提示"<BR>        Exit Sub<BR>    End If<BR>    '//更新提示信息<BR>    FrmProGress.lblDes = "正在处理宗地面拓扑错误……"<BR>    FrmProGress.Timer.Enabled = False<BR>    FrmProGress.Show<BR>    DoEvents<BR>    Dim lngLoop As Long<BR>    Dim lngCount As Long<BR>    On Error GoTo NEXTFEATURE<BR>    Dim pSpatialFilter As ISpatialFilter<BR>    Set pSpatialFilter = New SpatialFilter<BR>    <BR>    Dim pFeatureCursor As IFeatureCursor<BR>    <BR>    Dim dblLength As Double<BR>    Dim pTopologicalOperator As ITopologicalOperator2<BR>    Dim pPolyLine As IPolyline<BR>    Dim pPolygon As IPointCollection<BR>    Set pPolygon = New Polygon<BR>    <BR>    Set pTopoRuleCon = pTopology<BR>    Do While Not pTopoErrorFeature Is Nothing<BR>        Set pFeature = pTopoErrorFeature<BR>        Set pPolygon = New Polygon<BR>        pPolygon.AddPointCollection pFeature.ShapeCopy<BR>        Dim pPoly As IPolygon<BR>        Set pPoly = pPolygon<BR>        pPoly.Close<BR>        Set pPolygon = pPoly<BR>        If (TypeOf pPolygon Is IArea) Then<BR>            Set pTopologicalOperator = pPolygon<BR>            pTopologicalOperator.IsKnownSimple = False<BR>            pTopologicalOperator.Simplify<BR>            Set pPolygon = pTopologicalOperator<BR>            '//首先如果该拓扑错误包含要素,则作为例外处理<BR>            Set pSpatialFilter.Geometry = pPolygon<BR>            pSpatialFilter.SpatialRel = esriSpatialRelContains<BR>            <BR>            Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)<BR>            Set pSFeature = Nothing<BR>            Set pSFeature = pFeatureCursor.NEXTFEATURE<BR>            If Not pSFeature Is Nothing Then<BR>                pTopoRuleCon.PromoteToRuleException pTopoErrorFeature<BR>                GoTo NEXTFEATURE<BR>            End If<BR>            Set pArea3 = pPolygon<BR>            '//活着很下场<BR>            Dim pCurve As ICurve<BR>            Set pCurve = pPolygon<BR>            If pArea3.Area = 0 Then<BR>                pTopoRuleCon.PromoteToRuleException pTopoErrorFeature<BR>                GoTo NEXTFEATURE<BR>            End If<BR>            If Abs(pArea3.Area) <= g_GapTolerance Or Abs(pCurve.Length / pArea3.Area) > 5 Then '//在1平方米内的自动处理<BR>                '//获得与该要素相邻数据<BR>                '//空间搜索标准<BR>                pSpatialFilter.SpatialRel = esriSpatialRelTouches '//共界<BR>                Set pSpatialFilter.Geometry = pTopologicalOperator<BR>                pSpatialFilter.WhereClause = "mid(zdh,5,1) ='9'"<BR>                Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)<BR>                Set pSFeature = pFeatureCursor.NEXTFEATURE<BR>                '//获取公共部分<BR>                dblLength = 0<BR>                Set pDFeature = Nothing<BR>                Do While Not pSFeature Is Nothing<BR>                    Set pTopologicalOperator = pFeature.ShapeCopy<BR>                    Set pPolyLine = pTopologicalOperator.Intersect(pSFeature.ShapeCopy, esriGeometry1Dimension)<BR>                    If dblLength < pPolyLine.Length Then<BR>                        dblLength = pPolyLine.Length<BR>                        Set pDFeature = pSFeature<BR>                    End If<BR>                    Set pSFeature = pFeatureCursor.NEXTFEATURE<BR>                Loop<BR>                '//将裂隙对象付给最大的块地<BR>                If pDFeature Is Nothing Then GoTo NEXTFEATURE<BR>                Dim pGeometry As IGeometry<BR>                Dim pAimPolygon As IPolygon<BR>                Set pAimPolygon = pPolygon<BR>                pAimPolygon.Close<BR>                Set pTopologicalOperator = pAimPolygon<BR>                pTopologicalOperator.IsKnownSimple = False<BR>                pTopologicalOperator.Simplify<BR>                Set pTopologicalOperator = pDFeature.ShapeCopy<BR>                pTopologicalOperator.IsKnownSimple = False<BR>                pTopologicalOperator.Simplify<BR>                Set pGeometry = pTopologicalOperator.Union(pAimPolygon)<BR>                Set pDFeature.Shape = pGeometry<BR>                pDFeature.Store<BR>            Else '//不能处理的部分<BR>            End If<BR>            <BR>        End If<BR>        <BR>        <BR>        If lngLoop Mod 10 = 0 Then<BR>            DoEvents<BR>            FrmProGress.ProgressBar.Value = IIf(FrmProGress.ProgressBar.Value + 1 > FrmProGress.ProgressBar.Max, 1, FrmProGress.ProgressBar.Value + 1)<BR>        End If<BR>        <BR>        Dim pWsEdit As IWorkspaceEdit<BR>        Set pWsEdit = g_CheckWorkspace<BR>        <BR>        If lngLoop Mod 100 = 0 Then<BR>            pWsEdit.StopEditOperation<BR>            pWsEdit.StopEditing True<BR>            pWsEdit.StartEditing False<BR>            pWsEdit.StartEditOperation<BR>        End If<BR>        <BR>NEXTFEATURE:<BR>        Err.Clear<BR>        lngLoop = lngLoop + 1<BR>        Set pTopoErrorFeature = pEnumtopoErrorFeature.Next<BR>    Loop<BR>    DoEvents<BR>    <BR>    '//刷新界面<BR>    <BR>    Exit Sub<BR>PROC_ERR:<BR>    msgbox "自动处理缝隙错误:" ; err.description<BR>End Sub</P></DIV></TD></TR></TABLE></P>