POST
|
You can use IFeatureDataConverter to save a featureclass to a shapefile. Here is a quick example: Public Sub GetFeatureClassAndWorkspace()
Dim pOutSDEPropset As IPropertySet
Set pOutSDEPropset = New PropertySet
With pOutSDEPropset
.SetProperty "Server", "shakedown"
.SetProperty "Instance", "5151"
.SetProperty "user", "sde"
.SetProperty "password", "sde"
.SetProperty "version", "SDE.DEFAULT"
End With
' +++ Create a new feature datset name object for the output SDE feature dataset, call
' +++ it "USA"
Dim pSDEworkspacefactory As IWorkspaceFactory
Set pSDEworkspacefactory = New SdeWorkspaceFactory
Dim pWorkspace As IWorkspace
Set pWorkspace = pSDEworkspacefactory.Open(pOutSDEPropset, 0)
Dim pSFworkspacefactory As IWorkspaceFactory
Set pSFworkspacefactory = New ShapefileWorkspaceFactory
Dim pShapeWorkspace As IWorkspace
Set pShapeWorkspace = pSFworkspacefactory.OpenFromFile("C:\test_data\shapefiles", 0)
Dim pFeatWork As IFeatureWorkspace
Set pFeatWork = pShapeWorkspace
Dim pFeatureClass As IFeatureClass
Dim pFeatWs As IFeatureWorkspace
Set pFeatWs = pWorkspace
Set pFeatureClass = pFeatWs.OpenFeatureClass("States")
ConvertFeatureClass pFeatureClass, pFeatWork
End Sub
Public Sub ConvertFeatureClass(pFeatureClass As IFeatureClass, _
pOutWorkspace As IWorkspace)
'Purpose: Converts a featureclass to a new feature class in a given workspace.
'Get input FeatureClassName and workspace
Dim pInFCName As IFeatureClassName
Dim pDataset As IDataset
Set pDataset = pFeatureClass
Set pInFCName = pDataset.FullName
Dim pInWorkspace As IWorkspace
Set pInWorkspace = pDataset.Workspace
'Set output workspacename
Set pDataset = pOutWorkspace
Dim pOutWorkspaceName As IWorkspaceName
Set pOutWorkspaceName = pDataset.FullName
'Set output FeatureClassName
Dim pOutFCName As IFeatureClassName
Set pOutFCName = New FeatureClassName
Dim pDatasetName As IDatasetName
Set pDatasetName = pOutFCName
pDatasetName.Name = "States_SHP.shp"
Set pDatasetName.WorkspaceName = pOutWorkspaceName
'Get fields for input feature class and run them through field checker
Dim pFieldChecker As IFieldChecker
Dim pFields As IFields
Set pFields = pFeatureClass.Fields
Dim pOutFields As IFields
Set pFieldChecker = New FieldChecker
pFieldChecker.InputWorkspace = pInWorkspace
Set pFieldChecker.ValidateWorkspace = pOutWorkspace
pFieldChecker.Validate pFields, Nothing, pOutFields
'Convert the data
Dim pFeatureDataConverter As IFeatureDataConverter
Set pFeatureDataConverter = New FeatureDataConverter
pFeatureDataConverter.ConvertFeatureClass pInFCName, Nothing, _
Nothing, pOutFCName, Nothing, pOutFields, "", 100, 0
End Sub
... View more
03-20-2012
09:41 AM
|
0
|
0
|
421
|
POST
|
Both of these VBA samples will select multiple features in the map. To perform a spatial selection - "select within":
Sub SpatialSelection()
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pTargetLayer As IFeatureLayer
Dim pSelectingLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass
Dim pEnvelope As IEnvelope
Dim pFeatureSelection As IFeatureSelection
Dim pSpatialFilter As ISpatialFilter
Set pMxApp = Application
Set pMxDoc = Application.Document
Set pMap = pMxDoc.FocusMap
Set pTargetLayer = pMap.Layer(0)
Set pSelectingLayer = pMap.Layer(1)
Set pFeatureClass = pTargetLayer.FeatureClass
Set pEnvelope = pSelectingLayer.AreaOfInterest
Set pFeatureSelection = pTargetLayer
Set pSpatialFilter = New SpatialFilter
With pSpatialFilter
Set .Geometry = pEnvelope
.GeometryField = pFeatureClass.ShapeFieldName
.SpatialRel = esriSpatialRelContains
'add an optional .WhereClause
End With
pFeatureSelection.SelectFeatures pSpatialFilter, esriSelectionResultNew, False
pMxDoc.ActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
End Sub
To perform a selection of features within a graphic drawn in the map - this is MouseDown code for a UIToolControl, which will allow you to draw the graphic then selects the features within that graphic:
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pRubberBand As IRubberBand
Dim pSelectionSet As ISelectionSet
Dim pFeatureLayer As IFeatureLayer2
Dim pFeatureSelection As IFeatureSelection
Dim pTargetLayer As IFeatureLayer
Dim pCircleArc As ICircularArc
Dim pSegColl As ISegmentCollection
Dim pFLayer As IFeatureLayer
Dim pFc As IFeatureClass
Dim pPoly As IPolygon
Set pMxApp = Application
Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pActiveView = pMap
Set pTargetLayer = pMap.Layer(0)
Set pRubberBand = New RubberCircle
Set pCircleArc = pRubberBand.TrackNew(pActiveView.ScreenDisplay, Nothing)
Set pSegColl = New Polygon
pSegColl.SetCircle pCircleArc.CenterPoint, pCircleArc.Radius
Set pFLayer = pMap.Layer(0)
Set pFc = pFLayer.FeatureClass
Set pPoly = pSegColl
Dim pSF As ISpatialFilter
Set pSF = New SpatialFilter
With pSF
Set .Geometry = pPoly
.GeometryField = pTargetLayer.FeatureClass.ShapeFieldName
.SpatialRel = esriSpatialRelIntersects
End With
Set pFeatureSelection = pTargetLayer
pFeatureSelection.SelectFeatures pSF, esriSelectionResultNew, False
pMxDoc.ActiveView.Refresh
End Sub
... View more
02-17-2012
06:40 AM
|
0
|
0
|
755
|
Online Status |
Offline
|
Date Last Visited |
11-11-2020
02:24 AM
|