地图裁减程序
前几天写的那篇《地图裁减程序》的blog被我不小心删除了，所以在这里补一篇。
地图的裁减，主要功能是通过一个任意形状的裁减多边形，可以将目标要素类，无论是点、线、多边形还是标注图层，都可以进行裁减。裁减后的要素类形状与多边形一致。在这个过程中，需要裁减所有在多边形内部的要素，还要处理在多边形边界的polyline或polygon。
为了实现这个功能，我找到了三种方式：
1.使用ESRI自己提供的IBasicGeoprocessor:Clip命令
2.遍历一个要素类所有的要素，并与多边形进行拓扑关系判断，按照其在内部，在边界等不同位置产生新要素
3.使用多边形先做包含的包含关系空间过滤，将符合的要素进行处理；然后再对多边形做相交空间过滤，将获得的元素进行处理
我将三种方式都试验了一下，1的缺点很明显，效率低，占用CPU和内存，裁减要素数目大的图层迅速死机；2在处理包含少数要素的要素类（少于5K条）的时候效率比3高；3在处理大量要素时的性能良好。我的试验机器是双核CPU，1G内存，试验数据包括33个要素图层，要素总量为30W条，从中间裁减3W条，结果：1，死机；2，15m左右；3，8m左右。
花了好几天的时间来试验不同的方法，进行测试，设计UI，终于弄出了一个功能比较完整的小程序。
Select Case pInFeatCls.ShapeType
Case 1 'point
'如果点包含在多边形中
If (pRealOper.Contains(pInFeat.ShapeCopy)) Then
nFeatCur = nFeatCur + 1
Set pSaveFeat = pSaveFeatCls.CreateFeature
'如果是Annotation要素类，则复制Annotation
If bAnno = True Then
Dim pAF As IAnnotationFeature
Set pAF = pInFeat
Dim pNAF As IAnnotationFeature
Set pNAF = pSaveFeat
pNAF.Annotation = pAF.Annotation
End If
'Set pGeo = pTopo.Intersect(pInFeat.ShapeCopy, esriGeometry0Dimension)
'将该点要素添加到用于保存的要素类中
fillFldValue pInFeat, pSaveFeat, arrInSave(), nInSave, pInFeat.Shape
End If
Case 3 'polyline
'如果多义线穿越多边形或包含在多边形中
If (pRealOper.Crosses(pInFeat.ShapeCopy) Or (pRealOper.Contains(pInFeat.ShapeCopy))) Then
nFeatCur = nFeatCur + 1
Set pSaveFeat = pSaveFeatCls.CreateFeature
'获得相交部分的geometry
Set pGeo = pTopo.Intersect(pClipPoly, esriGeometry1Dimension)
fillFldValue pInFeat, pSaveFeat, arrInSave(), nInSave, pGeo
End If
Case 4 'polygon
'如果多边形与裁减多边形相交或在裁减多边形中
If ((pRealOper.Overlaps(pInFeat.ShapeCopy)) Or (pRealOper.Contains(pInFeat.ShapeCopy))) Then
nFeatCur = nFeatCur + 1
Set pSaveFeat = pSaveFeatCls.CreateFeature
Set pGeo = pTopo.Intersect(pClipPoly, esriGeometry2Dimension)
fillFldValue pInFeat, pSaveFeat, arrInSave(), nInSave, pGeo
Debug.Print "nfeatcur" & nFeatCur
End If
Case Else
End Select
Related Items
Comments
这个代码很简单，但我在blog中从来不直接给出具体代码，但我可以给你思路，有助于你自己理解。
1.在数据复制之前，比对两个要素类的字段结构，使用一个二维数组来存储，结构可以如下a(0,0)="name"[字段名]a(0,1)=5[在要素类A中该字段的字段索引为5]a(0,2)=3[在要素类B中索引为3]
2.在复制的时候，也就是FillFldValue，除了pSaveFeat.Shape=pInFeat.Shape外，其余的值都以来上面的数组来赋值，如pSaveFeat.Value(5)=pInFeat.Value(3)
还有 您在您的 地图裁剪程序 BLOG中有这样的代码:
If bAnno = True Then
Dim pAF As IAnnotationFeature
Set pAF = pInFeat
Dim pNAF As IAnnotationFeature
Set pNAF = pSaveFeat
pNAF.Annotation = pAF.Annotation
End If
所以我觉得不应该是poutannofeature.Annotation =pinannofeature.Annotation 的问题
我的代码中确实有这段，但它是在pInAnnoFeature的Annotation存在的情况下，而CAD数据中未必存在这个对象，所谓Annotation要素，无非是一个携带了ITextElement的面要素而已。你自己从CAD文本中提取这个ITextElement相应的信息即可。
Leave a comment
Or, take a look at Archives and Categories
不错,以后用到这个的话有得参看了