copy与粘贴？

请问版主mo中如何实现复制与张贴，移动等功能
<img src="images/post/smile/dvbbs/em05.gif" />

一些定义

Public m_selVertex As Long
Public m_selPart As Long
Public m_selLine As Long
只是把程序里的一些部分挑了出来，肯定还运行不了，你看看吧，也不知道有没用，最近太忙，没办法，回答问题没办法静下来，慢慢做好。
从菜单选择copy项

Private Sub MO_MENU_COPY_Click()
Dim layerNum As Long
layerNum = ActiveLayerIndex
If m_selLine = -1 And m_selPart = -1 And m_selVertex = -1 Then
    MsgBox ("首先必须选中一个要复制的实体!")
Else
    Dim recs As MapObjects2.Recordset
    Set recs = Map1.Layers(layerNum).Records
    If recs.Fields("Shape").Type = moLine Then
      clsMapT.UCpline Map1, layerNum, m_selLine
    ElseIf recs.Fields("Shape").Type = moPolygon Then
      clsMapT.UCpPoly Map1, layerNum, m_selLine
    Else
      clsMapT.UCpPoint Map1, layerNum, m_selVertex
    End If
End If

三个上面用到的函数

Function UCpPoint(map As MapObjects2.map, layerNum As Long, m_selVertex As Long)
 On Error GoTo exit1
 Dim mymap As MapObjects2.map
 Dim mylayer As Long
 Dim myselvertex As Long
 Set mymap = map
 mylayer = layerNum
 myselvertex = m_selVertex
 
 Set m_map = map
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 recs.MoveFirst
 'recs.Edit
 
 Dim i As Long
 For i = 0 To m_selVertex - 1
 recs.MoveNext
 Next
 
 Dim point As MapObjects2.point
 Dim mpoints As MapObjects2.points
 If recs.Fields("Shape").Type = moPoint Then
    Set point = recs.Fields("Shape").Value
    Set pointNew = Nothing
    CopyPoint pointNew, point
 ElseIf recs.Fields("Shape").Type = moPoints Then
    Set mpoints = recs.Fields("Shape").Value
    Set pointsNew = New MapObjects2.points
    CopyPoints pointsNew, mpoints
 End If
exit1:
End Function

Function UCpline(map As MapObjects2.map, layerNum As Long, m_selLine As Long)
On Error GoTo exit1
Dim mymap As MapObjects2.map
 Dim mylayer As Long
 Dim myselline As Long
 Set mymap = map
 mylayer = layerNum
 myselline = m_selLine
 
 Set m_map = map
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 recs.MoveFirst
 'recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 
 Dim Line As MapObjects2.Line
 Set Line = recs.Fields("Shape").Value
 Set lineNew = Nothing
 CopyLine lineNew, Line
exit1:
End Function

Function UCpPoly(map As MapObjects2.map, layerNum As Long, m_selLine As Long)
 On Error GoTo exit1
 Dim mymap As MapObjects2.map
 Dim mylayer As Long
 Dim myselline As Long
 Set mymap = map
 mylayer = layerNum
 myselline = m_selLine
 
 Set m_map = map
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 
 recs.MoveFirst
 'recs.Edit
 
 Dim i As Long
 For i = 0 To m_selLine - 1
 recs.MoveNext
 Next
 Dim Polygon As MapObjects2.Polygon
 Set Polygon = recs.Fields("Shape").Value
 Set polyNew = Nothing
 CopyPolygon polyNew, Polygon
exit1:
End Function

End Sub

谢谢
版主在百忙中回答小弟的问题
上面的代码是copy的事件，
还麻烦版主能将粘贴的事件贴出来，或是发给我
HUXL688@NENU.EDU.CN
谢谢
谢谢

菜单选择命令
Private Sub MO_MENU_PASTE_Click()
Dim layerNum As Long
layerNum = ActiveLayerIndex
Dim recs As MapObjects2.Recordset
Set recs = Map1.Layers(layerNum).Records
If recs.Fields("Shape").Type = moLine Then
   clsMapT.UCutPasteLine Map1, layerNum, 10, 10
ElseIf recs.Fields("Shape").Type = moPolygon Then
   clsMapT.UCutPastePoly Map1, layerNum, 10, 10
ElseIf recs.Fields("Shape").Type = moPoint Then
   clsMapT.UCutPastePoint Map1, layerNum, 10, 10
ElseIf recs.Fields("Shape").Type = moPoints Then
   clsMapT.UCutPastePoints Map1, layerNum, 10, 10
End If

End Sub

三个函数，需要自己看看哦，请不要问我，呵呵，最近太忙，难得去想，呵呵
Function UCutPastePoint(map As MapObjects2.map, layerNum As Long, x As Double, y As Double)
 On Error GoTo exit1
 Dim xx, yy As Double
 xx = x
 yy = y
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 'If recs.Fields("Shape").Type = moPoint Then
   pushTypeAStep utAddShape ' utAddPoint
   pushInt layerNum
   pushObject pointNew
   pushEnd
  
   recs.Edit
   recs.AddNew
   Set recs.Fields("Shape").Value = pointNew
   Set pointNew = Nothing
   Set pointsNew = Nothing
   recs.Update
   recs.StopEditing
   Refresh map
  
 'Else
 ' MsgBox ("实体类型错误！")
 'End If
exit1:
End Function

Function UCutPastePoints(map As MapObjects2.map, layerNum As Long, x As Double, y As Double)
 On Error GoTo exit1
 Dim xx, yy As Double
 xx = x
 yy = y
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 'If recs.Fields("Shape").Type = moPoint Then
   pushTypeAStep utAddShape ' utAddPoint
   pushInt layerNum
   pushObject pointsNew
   pushEnd
  
   recs.Edit
   recs.AddNew
   Set recs.Fields("Shape").Value = pointsNew
   Set pointNew = Nothing
   Set pointsNew = Nothing
   recs.Update
   recs.StopEditing
   Refresh map
  
 'Else
 ' MsgBox ("实体类型错误！")
 'End If
exit1:
End Function


Function UCutPasteLine(map As MapObjects2.map, layerNum As Long, x As Double, y As Double)
On Error GoTo exit1
Dim xx, yy As Double
xx = x
yy = y
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 'If recs.Fields("Shape").Type = moPoint Then
  pushTypeAStep utAddLine
  pushInt layerNum
  pushObject lineNew
  pushEnd
  
  recs.Edit
  recs.AddNew
  Set recs.Fields("Shape").Value = lineNew
  recs.Update
  recs.StopEditing
  Refresh map
  Set lineNew = Nothing
  
 'Else
 ' MsgBox ("实体类型错误！")
 'End If
exit1:
End Function

Function UCutPastePoly(map As MapObjects2.map, layerNum As Long, x As Double, y As Double)
 On Error GoTo exit1
 Dim xx, yy As Double
 xx = x
 yy = y
 Dim recs As MapObjects2.Recordset
 Set recs = map.Layers(layerNum).Records
 'If recs.Fields("Shape").Type = moPoint Then
   Dim objectNew As Object
   Set objectNew = polyNew
   pushTypeAStep utAddShape
   pushInt layerNum
   pushObject objectNew
   pushEnd
  
   recs.Edit
   recs.AddNew
   Set recs.Fields("Shape").Value = polyNew
  
   recs.Update
   recs.StopEditing
   Refresh map
   Set polyNew = Nothing
 'Else
 ' MsgBox ("实体类型错误！")
 'End If
exit1:
End Function

谢谢
版主
这些代码对我的启发很大
谢谢版主抽出时间来帮我解决问题？
同时祝愿版主工作顺利
<img src="images/post/smile/dvbbs/em04.gif" /><img src="images/post/smile/dvbbs/em06.gif" />

希望你多来发发你学习的想法，多交流，多谢兄弟支持！