MapX的一个VB例子

Public Type EraseTargetFeatureInfo
Count As Integer
LayerName As String
TargetKeys() As String
End Type

Option Explicit
Dim x1 As Double,y1 As Double,x2 As Double,y2 As Double
Dim eraseTargetFeature As EraseTargetFeatureInfo
Dim ftrCopyInfo As FeatureCopyInfo

Private Sub Combine_Click()
Dim ftr As MapXLib.Feature
Dim ftrs As MapXLib.Features
Dim ftrCombined As MapXLib.Feature
Dim styCombined As MapXLib.Style
Dim ftrType As MapXLib.FeatureTypeConstants
Dim intFtrCount As Integer
intFtrCount = Map1.Layers("USA").Selection.Count
If intFtrCount > 0 Then
Set ftrs = Map1.Layers("USA").Selection
ftrType = ftrs(1).Type
For Each ftr In ftrs
If ftr.Type <> ftrType Then
MsgBox "不能合并不同类型对象!",vbOKOnly + vbExclamation
Exit Sub
End If
Next

Set ftrCombined = Map1.Layers("USA").AddFeature(Map1.FeatureFactory.CombineFeatures(ftrs))
Set styCombined = ftrs(1).Style.Clone
ftrCombined.Style = styCombined
ftrCombined.Update

For Each ftr In ftrs
Map1.Layers("USA").DeleteFeature ftr
Next
Map1.Layers("USA").Selection.Replace ftrCombined
End If

End Sub

Private Sub Eraser_Click()
Dim ftrEraser As MapXLib.Feature
Dim ftrNewTarget As MapXLib.Feature
Dim ftrOldTarget As MapXLib.Feature
Dim styOldTarget As MapXLib.Style
Dim bInTargetErased As Boolean
Dim intCount As Integer
Dim i As Integer

intCount = 0
For i = 1 To eraseTargetFeature.Count
Set ftrOldTarget = Map1.Layers("USA").GetFeatureByKey(eraseTargetFeature.TargetKeys(i))
Set styOldTarget = ftrOldTarget.Style.Clone
Set ftrNewTarget = ftrOldTarget.Clone
bInTargetErased = False
For Each ftrEraser In Map1.Layers("USA").Selection
If ftrEraser.Type = miFeatureTypeRegion Then
If Map1.FeatureFactory.IntersectionTest(ftrNewTarget,ftrEraser,miIntersectFeature) Then
Set ftrNewTarget = Map1.FeatureFactory.EraseFeature(ftrNewTarget,ftrEraser)
bInTargetErased = True
End If
End If
Next
Next

If bInTargetErased Then
Set ftrNewTarget = Map1.Layers.InsertionLayer.AddFeature(ftrNewTarget)
Set ftrNewTarget.Style = styOldTarget
ftrNewTarget.Update

Map1.Layers.InsertionLayer.DeleteFeature ftrOldTarget
End If
End Sub

Private Sub EraseTarget_Click()
Dim ftr As MapXLib.Feature
Dim intFtrCount As Integer
intFtrCount = 0
For Each ftr In Map1.Layers("USA").Selection
If (ftr.Type = miFeatureTypeRegion) Or (ftr.Type = miFeatureTypeLine) Then
intFtrCount = intFtrCount + 1
ReDim Preserve eraseTargetFeature.TargetKeys(1 To intFtrCount)
eraseTargetFeature.TargetKeys(intFtrCount) = ftr.FeatureKey
End If
Next
eraseTargetFeature.Count = intFtrCount
eraseTargetFeature.LayerName = Map1.Layers("USA").Name
End Sub

Private Sub Intersect_Click()
Dim ftrIntersection As MapXLib.Feature
Dim ftrs As MapXLib.Features
Dim ftr As MapXLib.Feature
Dim intFtrCount As Integer
intFtrCount = Map1.Layers("USA").Selection.Count
If intFtrCount > 0 Then
Set ftrs = Map1.Layers.InsertionLayer.Selection
Set ftrIntersection = Map1.FeatureFactory.IntersectFeatures(ftrs)
Set ftrIntersection = Map1.Layers.InsertionLayer.AddFeature(ftrIntersection)
ftrIntersection.Style = ftrs(1).Style.Clone
ftrIntersection.Update
For Each ftr In ftrs
Map1.Layers("UAS").DeleteFeature ftr
Next
Map1.Layers.InsertionLayer.Selection.Replace ftrIntersection
End If
End Sub

Private Sub Label_Click()
Map1.CurrentTool = miLabelTool
End Sub

Private Sub Form_Load()

//确定编辑层
Dim lyrInsertion As MapXLib.Layer
Set lyrInsertion = Map1.Layers("USA")
lyrInsertion.Editable = True
Set Map1.Layers.InsertionLayer = lyrInsertion
End Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!