AE的图层中图块的复制与粘贴

在同一图层中的图块的复制与粘贴不会用,请多指教.如果能实现不同图层的最好!

<P>只是一个函数，参考一下，不过你说的单个和多个图层都能实现</P>
<P>'功能：复制地物<BR>Public Function CopyFeature() As Boolean<BR>    '得到选中的地物,如果没有则退出<BR>    '每次只复制一个地物<BR>    Dim ff_t_FeatureCursor As IFeatureCursor<BR>    Dim ff_t_pFeature As IFeature<BR>    If ff_m_CurLayer Is Nothing Then Exit Function<BR>    <BR>    <BR>    '获取选中的地物<BR>    Set ff_t_FeatureCursor = GetSelectedFeatures<BR>    If ff_t_FeatureCursor Is Nothing Then<BR>        MsgBox "请先选择要复制的地物!", vbExclamation + vbOKOnly, "警告"<BR>        CopyFeature = False<BR>        Exit Function<BR>    End If<BR>    '得到要显示节点的地物<BR>    Set ff_t_pFeature = ff_t_FeatureCursor.NextFeature<BR>    If ff_t_pFeature Is Nothing Then Exit Function<BR>    <BR>    '判断容器里是否有地物<BR>    If Not m_pCopyGeometry Is Nothing Then<BR>        If m_pCopyGeometry.Count > 0 Then<BR>            m_pCopyGeometry.RemoveAll<BR>        End If<BR>    Else<BR>        Set m_pCopyGeometry = New esriSystem.Array<BR>    End If<BR>    While Not ff_t_pFeature Is Nothing<BR>        '复制地物<BR>        m_pCopyGeometry.Add ff_t_pFeature.ShapeCopy<BR>        Set ff_t_pFeature = ff_t_FeatureCursor.NextFeature<BR>    Wend<BR>    CopyFeature = True<BR>End Function</P>

太感谢了,我试试

太牛了

我不知道怎么粘贴,怎么办?

<P>还是自己写写了，这个给个参考，下面的函数还调用createfeature等函数，其实你说的paste就是建立一个新的对象了</P>
<P>'功能：粘贴复制的地物<BR>Public Sub PasteFeature()<BR>    If m_pCopyGeometry Is Nothing Then<BR>        MsgBox "没有可粘贴的地物!", vbCritical, "警告"<BR>        Exit Sub<BR>    End If<BR>    <BR>    Dim ff_m_FeatureLayer As IFeatureLayer<BR>    Dim ff_m_FeatureClass As IFeatureClass<BR>  <BR>    If ff_m_CurLayer Is Nothing Then Exit Sub<BR>    Set ff_m_FeatureLayer = ff_m_CurLayer<BR>    Set ff_m_FeatureClass = ff_m_FeatureLayer.FeatureClass<BR>    If ff_m_FeatureClass Is Nothing Then Exit Sub<BR>    Dim pGeo As IGeometry<BR>    Set pGeo = m_pCopyGeometry.Element(0)<BR>    '判断要粘贴的地物是否与当前编辑图层的Shape类型一致<BR>    If pGeo.GeometryType <> ff_m_FeatureClass.ShapeType Then<BR>        MsgBox "要粘贴的地物和目标层的类型不匹配", vbInformation, "警告"<BR>        Exit Sub<BR>    End If<BR>    <BR>    '清除被选中的地物<BR>    ff_m_Map.ClearSelection<BR>    Set ff_m_ActiveView = ff_m_Map<BR>    ff_m_ActiveView.Refresh<BR>    <BR>    '创建Feature<BR>    Dim i As Integer<BR>    For i = 0 To m_pCopyGeometry.Count - 1<BR>        Set pGeo = m_pCopyGeometry.Element(i)<BR>        CreateFeature pGeo<BR>    Next i<BR>    <BR>End Sub</P>

<P>厉害</P>

太感谢GIS老兄,希望以后多多指教