Private Sub AddCircle_Click()
Map1.CurrentTool = MyAddCircleTool
End Sub
Private Sub Form_Load()
'确定编辑层
Dim lyrInsertion As MapXLib.Layer
Set lyrInsertion = Map1.Layers("USA")
lyrInsertion.Editable = True
Set Map1.Layers.InsertionLayer = lyrInsertion
Map1.CreateCustomTool MyAddCircleTool, miToolTypeCircle, miCrossCursor
End Sub
Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
Dim pntBorder As New Point
Dim pntsBorder As New Points
Dim pntCenter As New Point
Dim intNodesLBound As Integer
Dim intCoords As Integer
Dim NodesRegon As Variant
Dim rectBounds As New MapXLib.Rectangle
Dim i As Integer
Select Case ToolNum
Case MyAddCircleTool
If Distance > 0 Then
pntCenter.Set x1, y1
Dim ftrCircle As MapXLib.Feature
Set ftrCircle = Map1.Layers.InsertionLayer.AddFeature(Map1.FeatureFactory.CreateCircularRegion(miCircleTypeMap, pntCenter, Distance))
NodesRegon = ftrCircle.Nodes
Map1.Layers.InsertionLayer.DeleteFeature ftrCircle
intNodesLBound = LBound(NodesRegon, 1)
intCoords = NodesRegon(intNodesLBound, 1) * 2
i = 0
For i = intNodesLBound + 1 To intCoords Step 2
pntBorder.Set NodesRegon(i, 1), NodesRegon(i + 1, 1)
pntsBorder.Add pntBorder
Text1.Text = Text1.Text & pntBorder.X & " " & pntBorder.Y & vbCrLf
Next i
Set ftrCircle = Map1.Layers.InsertionLayer.AddFeature(Map1.FeatureFactory.CreateLine(pntsBorder))
Map1.Layers.InsertionLayer.KeyField = "State"
ftrCircle.KeyValue = "new Circle"
ftrCircle.Update
End If
End Select
End Sub