I want to crate polyline feature using mouse picking points(first point and second point) through pick points coordinates in ArcMap VBA could you please tell how to take mouse pick points.
Private Sub procesFeat()Dim pMxDoc As IMxDocumentDim pMap As IMapDim pEnmFeat As IEnumFeatureDim SVRFclass As IFeatureClassDim NewService As IFeatureDim pcol As IPolylineDim pNfeat As IFeatureDim ind_mat As IntegerDim ind_ns As IntegerDim ptype As IntegerDim indcond As IntegerDim firstPoint As IPointDim secondPoint As IPoint
Set NewService = GetCompositeFC("MPServicePipe")Set NewService = SVRFclass.CreateFeature 'CREATING SEVICE LINESet pcol = New polylinepcol.FromPoint = firstPointpcol.ToPoint = secondPointSet NewService.Shape = pcol indcond = NewFeature.Fields.FindField("SERVICETYPE") NewFeature.Value(indcond) = "STND" NewFeature.Store
End SubPrivate Function GetCompositeFC(strFCName As String) As IFeatureClassDim pMxDoc As IMxDocumentDim pMap As IMapDim pEnumLayer As IEnumLayerDim player As ILayerDim pFeatLayer As IFeatureLayerSet pMxDoc = ThisDocumentSet pMap = pMxDoc.ActiveView.FocusMapSet pEnumLayer = pMap.layers(Nothing, True)pEnumLayer.ResetSet player = pEnumLayer.Next()Dim pRetFeatClass As IFeatureClassDim pDataset As IDatasetDo Until player Is Nothing If TypeOf player Is IFeatureLayer Then Set pFeatLayer = player Set pDataset = pFeatLayer.featureClass If Not (pDataset Is Nothing) Then If (pDataset.name = strFCName) Then Set pRetFeatClass = pFeatLayer.featureClass Set GetCompositeFC = pRetFeatClass Exit Function End If End If Else End If Set player = pEnumLayer.NextLoop Set pEnumLayer = Nothing Set GetCompositeFC = NothingEnd Function
أكثر...
Private Sub procesFeat()Dim pMxDoc As IMxDocumentDim pMap As IMapDim pEnmFeat As IEnumFeatureDim SVRFclass As IFeatureClassDim NewService As IFeatureDim pcol As IPolylineDim pNfeat As IFeatureDim ind_mat As IntegerDim ind_ns As IntegerDim ptype As IntegerDim indcond As IntegerDim firstPoint As IPointDim secondPoint As IPoint
Set NewService = GetCompositeFC("MPServicePipe")Set NewService = SVRFclass.CreateFeature 'CREATING SEVICE LINESet pcol = New polylinepcol.FromPoint = firstPointpcol.ToPoint = secondPointSet NewService.Shape = pcol indcond = NewFeature.Fields.FindField("SERVICETYPE") NewFeature.Value(indcond) = "STND" NewFeature.Store
End SubPrivate Function GetCompositeFC(strFCName As String) As IFeatureClassDim pMxDoc As IMxDocumentDim pMap As IMapDim pEnumLayer As IEnumLayerDim player As ILayerDim pFeatLayer As IFeatureLayerSet pMxDoc = ThisDocumentSet pMap = pMxDoc.ActiveView.FocusMapSet pEnumLayer = pMap.layers(Nothing, True)pEnumLayer.ResetSet player = pEnumLayer.Next()Dim pRetFeatClass As IFeatureClassDim pDataset As IDatasetDo Until player Is Nothing If TypeOf player Is IFeatureLayer Then Set pFeatLayer = player Set pDataset = pFeatLayer.featureClass If Not (pDataset Is Nothing) Then If (pDataset.name = strFCName) Then Set pRetFeatClass = pFeatLayer.featureClass Set GetCompositeFC = pRetFeatClass Exit Function End If End If Else End If Set player = pEnumLayer.NextLoop Set pEnumLayer = Nothing Set GetCompositeFC = NothingEnd Function
أكثر...