画基站扇区的一种方法

'创建扇区
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

转载于:https://www.cnblogs.com/googlegis/archive/2011/06/15/2978845.html

软件介绍: 本工具为《GoogleEarth基站扇区绘制工具(YZL)》V3.5版,实现EXCEL表 中直接生成KML文件,方便在Googffiearth中显示基站相关信息,方便无线规 划和优化专业冋仁更加形象的了解相关情况。该工具的主要功能如下:本程序采用EXCEL VBA方式实现在GE中显示基站扇区图形和信息,使用方便;3.0以后版本实现了类似于MAPINFO专题地图类似的分档功能;本程序采图0-1用了大地主题解算算法,绘制的扇区图形更逼真;本程序可实现扇区相关图片插入,然后可在GE中另存为KMZ文件以 方便在不同机器之间转移,方便掌握和查看相关信息;本程序可实现基站扇区信息表格化方式体现;实现了点样式、直线样式、面域样式的样式选择控制;采用扇形绘制扇区时可采用三叶草样式或者普通扇形样式;可支持经纬度、方位角、半径、半功率角、高度、下倾角等的自定义或 者选择相应列输入;可选择输入运营商logo图标等个性化设置;可生成在屏幕上位置固定的图例;如果经常使用的话可以将常用设置保存下来在需要的时候导入。考虑到程序的运行效率,建议分当数设置在100以下。郑重声明:“data”表一定不要删除第一列和第一行(这一列用来记录是 否有图片,第一行作为相关列的名称使用,删除将会出错)由于 kml文档格式本身的问题,当扇区数超过一定数量时,kml文件将 相当大(可能超过100M),这样影响GE中打开的^。建议每次操作 扇区数控制在5000以下。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值