[代码]把 graphic features 转换到编辑的图层中

Option Explicit<BR><BR>Private Sub GraphicsToFeatures()<BR><BR>  'exports selected graphic features to the currently edited feature class<BR>  <BR>  'adapted by:  Justin Johnson<BR>  'authalic@yahoo.com<BR>  '<BR>  'modified from code originally written by:<BR>  '  Tim Lomas and Stephen Mau (Terrace GIS)<BR>  '  authors of "Convert Graphics to Features" arcscript<BR>  '<BR>  'Updated May 20, 2005<BR>  '  Works with 3D feature layers<BR>  '  Compatible with ArcGIS 9.0<BR><BR>  Dim pMxApp As IMxApplication<BR>  Dim pMxDoc As IMxDocument<BR>  Dim pID As New UID<BR>  Dim pEditor As IEditor<BR>  Dim pGraphicsContainer As IGraphicsContainer<BR>  Dim pGraphContSel As IGraphicsContainerSelect<BR>  <BR>  Set pMxApp = Application<BR>  Set pMxDoc = Application.Document<BR>  pID = "esriEditor.Editor"  'version 9.0 compatible.  Previously:  PID = "esriCore.Editor"<BR>  Set pEditor = Application.FindExtensionByCLSID(pID)<BR>  Set pGraphicsContainer = pMxDoc.FocusMap<BR>  Set pGraphContSel = pGraphicsContainer<BR>  <BR>  Dim pEditLayers As IEditLayers<BR>  Dim pFeatureLayer As IFeatureLayer<BR>  Set pEditLayers = pEditor<BR>  Set pFeatureLayer = pEditLayers.CurrentLayer<BR>  <BR>  Dim pGraphicElementEnum As IEnumElement<BR>  Set pGraphicElementEnum = pGraphContSel.SelectedElements  'get selected graphics<BR>  <BR>  pGraphicElementEnum.Reset<BR>  <BR>  Dim pElement As IElement<BR>  Set pElement = pGraphicElementEnum.Next<BR>  <BR>  'check if edit session is present<BR>  If Not pEditor.EditState = esriStateEditing Then<BR>    MsgBox "Operation requires an edit session", vbExclamation, "No Edit Session"<BR>    Exit Sub<BR>  End If<BR>  <BR>  'check if graphics are selected<BR>  If pElement Is Nothing Then<BR>    MsgBox "Graphic selection required", vbExclamation, "No Graphics Selected"<BR>    Exit Sub<BR>  End If<BR>     <BR>  pEditor.StartOperation<BR>  <BR>  On Error GoTo Error_Handler<BR>  <BR>    Do While Not pElement Is Nothing  'loop through the graphics<BR>    <BR>      Dim pGeom As IGeometry<BR>      Set pGeom = pElement.Geometry<BR>      <BR>      If pGeom.GeometryType = pFeatureLayer.FeatureClass.ShapeType Then<BR>        'geometry types of graphic and output feature layer are the same<BR>      <BR>        Dim pFeature As IFeature<BR>        Set pFeature = pFeatureLayer.FeatureClass.CreateFeature 'create new output feature<BR>        <BR>        Dim pGeoDef As IGeometryDef<BR>        Dim pZAw As IZAware<BR>        Dim pMAw As IMAware<BR>        Dim pFld As Long<BR>        <BR>        pFld = pFeatureLayer.FeatureClass.FindField(pFeatureLayer.FeatureClass.ShapeFieldName)<BR>        'find Geometry field<BR>        <BR>        Set pGeoDef = pFeatureLayer.FeatureClass.Fields.Field(pFld).GeometryDef<BR>        Set pZAw = pGeom<BR>        <BR>        If pGeoDef.HasZ Then   'Test if output layer is Z aware.<BR>          'The Z values of points and polyline/polygon vertices need to be set to zero,<BR>          'or an error will result when feature is saved to the output feature class<BR>          <BR>          pZAw.ZAware = True  'make feature Z aware<BR>          <BR>          If pGeom.GeometryType <> esriGeometryPoint Then<BR>            'problem: Points do not implement the IZ interface and must be treated differently<BR>                     <BR>            Dim pZ As IZ<BR>            Set pZ = pGeom<BR>            pZ.SetConstantZ 0  'set all Z values of vertices to zero<BR>         <BR>          Else<BR>            'point features need to have their Z values set to zero<BR>            <BR>            Dim pPt As esriGeometry.IPoint  'changed from version 8.3, previously esriCore.IPoint<BR>            Set pPt = pGeom<BR>            pPt.Z = 0<BR>                        <BR>          End If<BR>        End If<BR>                <BR>        Set pMAw = pGeom<BR>        <BR>        If pGeoDef.HasM Then    'test if output feature class has M values<BR>          Set pMAw = pGeom<BR>          pMAw.MAware = True    'make new feature M aware<BR>        End If<BR>                <BR>        'store new feature<BR>        Set pFeature.Shape = pGeom<BR>        pFeature.Store<BR>        <BR>        'delete the graphic element after it has been converted to a feature<BR>        pGraphicsContainer.DeleteElement pElement<BR>        <BR>      End If<BR>      <BR>      Set pElement = pGraphicElementEnum.Next<BR>    <BR>    Loop<BR>    <BR>  pEditor.StopOperation "Convert Features from Graphics"  'allows ability to "undo" edits<BR>  pMxDoc.ActiveView.Refresh<BR>  <BR>  Exit Sub<BR>  <BR>Error_Handler:<BR>  pEditor.AbortOperation<BR>  MsgBox Err.Description<BR><BR>End Sub<BR>