画基站扇区的一种方法

'创建扇区
Private Function FeatureFactoryCell(ByVal longitude As Double, ByVal latitude As Double, 
ByVal angle As Integer, ByVal Lac As Integer, ByVal sectorSign As Integer) As Feature

Dim FeatureRegion As Feature
Dim FeatureCircular As Feature
Dim FeatureSector   As Feature
Dim pointCenter   As New Point
Dim pointTemp   As New Point
Dim pointRegion As New Points
Dim angleInteger As Integer
Dim angleMod As Integer
Dim angleTemp1 As Integer
Dim angleTemp2 As Integer

pointCenter.Set longitude, latitude

If (angle < 0 Or angle > 360) Then
MsgBox "基站小区角度存在误差"
End If

'增加扇区的中心点
pointTemp.Set longitude, latitude
pointRegion.Add pointTemp

'三角形的右上角坐标，并添加到点集
angleTemp1 = angle + 30

If (angleTemp1 > 360) Then
    angleTemp1 = angleTemp1 - 360
End If

   angleInteger = angleTemp1 \ 90
   angleMod = angleTemp1 Mod 90

     Select Case angleInteger
         Case 0
             pointTemp.Set longitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
         Case 1
             pointTemp.Set longitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979), 
latitude - distanceRegion * Sin(angleMod / 180 * 3.14159265358979)
         Case 2
             pointTemp.Set longitude - distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude - distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
         Case 3
             pointTemp.Set longitude - distanceRegion * Cos(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979)
         Case 4
             pointTemp.Set longitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
    
     End Select

pointRegion.Add pointTemp

'三角形的左上角坐标，并添加到点集
     angleTemp1 = angle - 30

If (angleTemp1 < 0) Then
    angleTemp1 = angleTemp1 + 360
End If

     angleInteger = angleTemp1 \ 90
     angleMod = angleTemp1 Mod 90

     Select Case angleInteger
         Case 0
             pointTemp.Set longitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
         Case 1
             pointTemp.Set longitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979), 
latitude - distanceRegion * Sin(angleMod / 180 * 3.14159265358979)
         Case 2
             pointTemp.Set longitude - distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude - distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
         Case 3
             pointTemp.Set longitude - distanceRegion * Cos(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979)
         Case 4
             pointTemp.Set longitude + distanceRegion * Sin(angleMod / 180 * 3.14159265358979), 
latitude + distanceRegion * Cos(angleMod / 180 * 3.14159265358979)
     End Select

pointRegion.Add pointTemp

If sectorSign = 1 Then

     Set FeatureRegion = Map1.FeatureFactory.CreateRegion(pointRegion)
     Set FeatureCircular = Map1.FeatureFactory.CreateCircularRegion(miCircleTypeMap, pointCenter, 0.1, , 15)    '（圆形）
     Set FeatureSector = Map1.FeatureFactory.IntersectFeatures(FeatureRegion, FeatureCircular) '(组合图元)

Else
     Set FeatureRegion = Map1.FeatureFactory.CreateRegion(pointRegion)
     Set FeatureCircular = Map1.FeatureFactory.CreateCircularRegion(miCircleTypeMap, pointCenter, 0.3, , 15)   '（圆形）
     Set FeatureSector = Map1.FeatureFactory.IntersectFeatures(FeatureRegion, FeatureCircular) '(组合图元)

End If
  
   '连接数据库,设置扇区样式

    Dim SQL As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.ConnectionString = "Data Source=" & App.Path & "\data.mdb"
cn.Open
SQL = "select LAC,RED,BLUE,GREEN from laccolor"
Set rs = New ADODB.Recordset
Set rs.ActiveConnection = cn
rs.Open SQL
rs.MoveFirst

While Not rs.EOF
If Lac = rs.Fields.Item("LAC") Then
FeatureSector.Style.RegionColor = RGB(rs.Fields.Item("RED"), rs.Fields.Item("BLUE"), rs.Fields.Item("GREEN"))
'rs.MoveLast
End If
rs.MoveNext
Wend

rs.Close
cn.Close

Set FeatureFactoryCell = FeatureSector

End Function