前端之家收集整理的这篇文章主要介绍了
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
原文链接:https://www.f2er.com/vb/259568.html