ArcMap VBA对点面属性数据的一些操作

大部分code都是粘的。。比较乱,反正是能用了1.功能:将mxd中第一个图层,也就是layer_index=0的图层中的点遍历,把位置信息写到点地物的属性longitude和latitude里去

PrivateFunctionEditFeature(pFeatureClassAsIFeatureClass)AsBooleanDimpFeatureAsIFeatureDimpFeatureCursorAsIFeatureCursorDimpPointAsIPointDimamountAsLongOnErrorGoToErrorHandler:EditFeature=FalseIf(pFeatureClassIsNothing)ThenExitFunctionEndIfSetpFeatureCursor=pFeatureClass.Update(Nothing,False)SetpFeature=pFeatureCursor.NextFeatureamount=0While(NotpFeatureIsNothing)IfpFeature.Shape.GeometryType=esriGeometryPointThenSetpPoint=pFeature.ShapeCopypFeature.Value(pFeature.Fields.FindField(“longitude”))=pPoint.XpFeature.Value(pFeature.Fields.FindField(“latitude”))=pPoint.YpFeatureCursor.UpdateFeaturepFeatureamount=amount+1EndIfSetpFeature=pFeatureCursor.NextFeatureWendMsgBox”共更新记录”&amount&”条”ExitFunctionErrorHandler:MsgBoxamount&”行数据出问题了!!”&Err.DescriptionEndFunctionPrivateFunctionOpenFeatureClass()AsIFeatureClassDimpMxDocumentAsIMxDocumentDimpMapAsIMapDimpFeatureLayerAsIFeatureLayerDimpFeatureClassAsIFeatureClassOnErrorGoToErrorHandler:SetOpenFeatureClass=NothingSetpMxDocument=ThisDocumentSetpMap=pMxDocument.FocusMapIf(pMap.LayerCount=0)ThenMsgBox(“缺少数据”)ExitFunctionEndIfSetpFeatureLayer=pMap.Layer(0)SetpFeatureClass=pFeatureLayer.FeatureClassSetOpenFeatureClass=pFeatureClassExitFunctionErrorHandler:MsgBoxErr.DescriptionEndFunctionSubdosth()OnErrorGoToErrorHandler:DimpFeatureClassAsIFeatureClassSetpFeatureClass=OpenFeatureClass()EditFeaturepFeatureClassExitSubErrorHandler:MsgBoxErr.DescriptionEndSub2.功能:读出点地物所属的面地物的属性,再将此属性值赋给点地物的属性,执行很慢的,要有耐心。。

PrivateFunctiongetWantValue(ByValpPointAsIPoint,ByValFiledNameAsString)AsLongDimpMxApplicationAsIMxApplicationDimpMxDocumentAsIMxDocumentDimpMapAsIMapDimpIDArrayAsIArrayDimpIdentifyAsIIdentifyDimpFeatureIdentifyObjAsIFeatureIdentifyObjDimpIdentifyObjAsIIdentifyObjDimpRowIdentifyObjAsIRowIdentifyObjectDimpFeatureAsIFeatureDimpFieldsAsIFieldsDimpFieldAsIFieldDimiFieldIndexAsIntegerDimiLayerIndexAsIntegerDimsShapeAsStringSetpMxApplication=ApplicationSetpMxDocument=Application.DocumentSetpMap=pMxDocument.FocusMap’查询的是第二层,就是面地物层,layerIndex=1iLayerIndex=1SetpIdentify=pMap.Layer(iLayerIndex)SetpIDArray=pIdentify.Identify(pPoint)IfNotpIDArrayIsNothingThenSetpFeatureIdentifyObj=pIDArray.Element(0)SetpIdentifyObj=pFeatureIdentifyObjpIdentifyObj.FlashpMxApplication.DisplaySetpRowIdentifyObj=pFeatureIdentifyObjSetpFeature=pRowIdentifyObj.RowgetWantValue=pFeature.Value(pFeature.Fields.FindField(FiledName))EndIfEndFunctionPrivateFunctionEditFeature(pFeatureClassAsIFeatureClass)AsBooleanDimpFeatureAsIFeatureDimpFeatureCursorAsIFeatureCursorDimpPointAsIPointDimamountAsLongOnErrorGoToErrorHandler:EditFeature=FalseIf(pFeatureClassIsNothing)ThenExitFunctionEndIfSetpFeatureCursor=pFeatureClass.Update(Nothing,False)SetpFeature=pFeatureCursor.NextFeatureamount=0While(NotpFeatureIsNothing)IfpFeature.Shape.GeometryType=esriGeometryPointThenSetpPoint=pFeature.ShapeCopy’将得到的面地物的属性赋给点地物pFeature.Value(pFeature.Fields.FindField(“point_areaID”))=getWantValue(pPoint,”areaID”)pFeatureCursor.UpdateFeaturepFeatureamount=amount+1EndIfSetpFeature=pFeatureCursor.NextFeatureWendMsgBox”共更新记录”&amount&”条”ExitFunctionErrorHandler:MsgBoxErr.DescriptionEndFunctionPrivateFunctionOpenFeatureClass()AsIFeatureClassDimpMxDocumentAsIMxDocumentDimpMapAsIMapDimpFeatureLayerAsIFeatureLayerDimpFeatureClassAsIFeatureClassOnErrorGoToErrorHandler:SetOpenFeatureClass=NothingSetpMxDocument=ThisDocumentSetpMap=pMxDocument.FocusMapIf(pMap.LayerCount=0)ThenMsgBox(“缺少数据”)ExitFunctionEndIf’点地物所在层layerIndex=0SetpFeatureLayer=pMap.Layer(0)SetpFeatureClass=pFeatureLayer.FeatureClassSetOpenFeatureClass=pFeatureClassExitFunctionErrorHandler:MsgBoxErr.DescriptionEndFunctionSubdosth()OnErrorGoToErrorHandler:DimpFeatureClassAsIFeatureClassSetpFeatureClass=OpenFeatureClass()EditFeaturepFeatureClassExitSubErrorHandler:MsgBoxErr.DescriptionEndSub上帝从不埋怨人们的愚昧,人们却埋怨上帝的不公平

ArcMap VBA对点面属性数据的一些操作

相关文章:

你感兴趣的文章:

标签云: