Private Type FeatureCopyInfo
Count As Integer
ftrCopy() As MapXLib.Feature
Ftrkey() As String
FtrLayer As MapXLib.Layer
End Type
Private m_udtFtrCopyInfo As FeatureCopyInfo
Private Sub mnuEditCopy_Click()
Dim ftr As MapXLib.Feature
Dim ftrs As MapXLib.Features
Dim intCopyCount As Integer
Dim pntTextPos As MapXLib.Point
Dim styText As MapXLib.Style
Dim strText As String
If Not Map1.Layers.InsertionLayer Is Nothing Then
intCopyCount = Map1.Layers.InsertionLayer.Selection.Count
If intCopyCount > 0 Then
m_udtFtrCopyInfo.Count = intCopyCount
m_udtFtrCopyInfo.FtrLayer = Map1.Layers.InsertionLayer
ReDim m_udtFtrCopyInfo.ftrCopy(1 To intCopyCount)
ReDim m_udtFtrCopyInfo.Ftrkey(1 To intCopyCount)
intFtrCount = 0
Set ftrs = Map1.Layers.InsertionLayer.Selection
For Each ftr In ftrs
intFtrCount = intFtrCount + 1
If ftr.Type = miFeatureTypeText Then
Set pntTextPos = ftr.Point
Set styText = ftr.Style
strText = ftr.Caption
Set m_udtFtrCopyInfo.ftrCopy(intFtrCount) = Map1.FeatureFactory.CreateText(potTextPos, strText, miPositionCC, styText)
Else
Set m_udtFtrCopyInfo.ftrCopy(intFtrCount) = ftr.Clone
End If
Next
End If
End If
End Sub
Private Sub mnuEditCut_Click()
Dim ftr As MapXLib.Feature
Dim ftrs As MapXLib.Features
If Not Map1.Layers.InsertionLayer Is Nothing Then
mnuEditCopy_Click
'删除选中图元
If m_udtFtrCopyInfo.Count > 0 Then
Set ftrs = Map1.Layers.InsertionLayer.Selection
For Each ftr In ftrs
Map1.Layers.InsertionLayer.DeleteFeature ftr
Next
End If
End If
End Sub
Private Sub mnuEditPaste_Click()
Dim intCopyCount As Integer
Dim ftrNew As MapXLib.Feature
Dim intScroffset As Integer
Dim dblMapX As Double
Dim dblMapY As Double
Dim sngScrX As Single
Dim sngScrY As Single
Dim dblOffxetMapX As Double
Dim dblOffsetMapY As Double
Dim i As Integer
intScroffset = 50
intCopyCount = m_udtFtrCopyInfo.Count
If (Not Map1.Layers.InsertionLayer Is Nothing) And (intCopyCount > 0) Then
For i = 1 To intCopyCount
'偏移复制图元位置，以避免复制图元和复制图元的位置重合
dblMapX = m_udtFtrCopyInfo.ftrCopy(i).CenterX
dblMapY = m_udtFtrCopyInfo.ftrCopy(i).CenterY
Map1.ConvertCoord sngScrX, sngScrY, dblMapX, dblMapY, miMapToScreen
sngScrX = sngScrX - intScroffset
sngScrY = sngScrY - intScroffset
Map1.ConvertCoord sngScrX, sngScrY, dblOffsetMapX, dblOffsetMapY, miScreenToMap
dblOffsetMapX = dblOffsetMapX - dblMapX
dblOffsetMapY = dblOffsetMapY - dblMapY
m_udtFtrCopyInfo.ftrCopy(i).Lffset dblOffsetMapX, dblOffsetMapY
Set ftrNew = Map1.Layers.InsertionLayer.AddFeature(m_udtFtrCopyInfo.ftrCopy(i))
If ftrNew.Type <> miFeatureTypeText Then
End If
m_udtFtrCopyInfo.ftrCopy(i).Offset -dblOffsetMapX, -dblOffsetMapY
Next i
End If
End Sub