图形化割接方案制定软件

Const NAME_COLUMN = 0

Const TYPE_COLUMN = 1

Const SIZE_COLUMN = 2

Const DATE_COLUMN = 3

Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Dim mbMoving As Boolean

Const sglSplitLimit = 500

Private Sub AllQuery_Click()

MapInfo.RunMenuCommand M_ANALYZE_SELECTALL

End Sub

Private Sub AntiAllQuery_Click()

MapInfo.RunMenuCommand 311

End Sub

Private Sub CalStastics_Click()

MapInfo.RunMenuCommand M_ANALYZE_CALC_STATISTICS

End Sub

Private Sub Find_Selection_Click()

MapInfo.RunMenuCommand M_ANALYZE_FIND_SELECTION

End Sub

Private Sub FindSome_Click()

MapInfo.RunMenuCommand M_ANALYZE_FIND

End Sub

Private Sub Form_Load()

Dim strSQL, strSQLad As String

Dim rstbts, adRecordset As New ADODB.Recordset

Set rstbts = New ADODB.Recordset

Set adRecordset = New ADODB.Recordset

Dim nodx As Node

'Dim theResponder1 As Object

Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)

Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)

Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)

Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500) InitializeMapInfoConnection

Set connaccess = New ADODB.Connection

With connaccess

.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\database.mdb"

.CommandTimeout = 0

.Open

End With

TheInstallPath = App.Path + "\"

MapInfo.do "set window info parent " & fMainForm.picMapFrame.hwnd

MapInfo.do "set window legend parent " & fMainForm.picMapFrame.hwnd

MapInfo.do "set window ruler parent " & fMainForm.picMapFrame.hwnd

MapInfo.do "set window statistics parent " & fMainForm.picMapFrame.hwnd

' Run Menu Command

tvTreeView.LineStyle = tvwRootLines '在兄弟节点和父节点之间显示线

strSQL = "SELECT distinct msc FROM bsc资源"

rstbts.Open strSQL, connaccess, adOpenStatic, adLockOptimistic

While Not (rstbts.EOF)

tvTreeView.Nodes.Add , , "msc" & rstbts!msc, "msc" & rstbts!msc

strSQLad = "SELECT * FROM bsc资源where msc=" & rstbts!msc & " order by bsc asc"

adRecordset.Open strSQLad, connaccess, adOpenStatic, adLockOptimistic

While Not (adRecordset.EOF)

Set nodx = tvTreeView.Nodes.Add("msc" & rstbts!msc, tvwChild, ConvertString(adRecordset!bsc, ""), ConvertString(adRecordset!bsc, ""))

adRecordset.MoveNext

Wend

Set adRecordset = Nothing

rstbts.MoveNext

Wend

Set rstbts = Nothing

' With https://www.360docs.net/doc/bb15027608.html,TreeView

'

' .Nodes.Add , , "msc" & rstbts!msc, "msc" & rstbts!msc

'

'End With

' With https://www.360docs.net/doc/bb15027608.html,TreeView

' '* clear out any previous info tool hits

' .Nodes.Clear

' If nHits = 0 Then

' '* there were no hits: disable the TreeView control

' .Nodes.Add , , "noinfo", "< No Records >"

' .Enabled = False

' Else

End Sub

Private Sub Form_Paint()

' lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0")) ' Select Case lvListView.View

' Case lvwIcon

' tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed

' Case lvwSmallIcon

' tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed

' Case lvwList

' tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed

' Case lvwReport

' tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed

' End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)

MapInfo.RunMenuCommand M_FILE_EXIT

Dim I As Integer

'close all sub forms

For I = Forms.Count - 1 To 1 Step -1

Unload Forms(I)

Next

If Me.WindowState <> vbMinimized Then

SaveSetting App.Title, "Settings", "MainLeft", Me.Left

SaveSetting App.Title, "Settings", "MainTop", Me.Top

SaveSetting App.Title, "Settings", "MainWidth", Me.Width

SaveSetting App.Title, "Settings", "MainHeight", Me.Height End If

' SaveSetting App.Title, "Settings", "ViewMode", lvListView.View ShutdownMapInfoConnection

Set connaccess = Nothing

End Sub

Private Sub LayerQuery_Click()

MapInfo.RunMenuCommand M_ANALYZE_SELECT

End Sub

Private Sub menuMapCreateThematic_Click()

MapInfo.RunMenuCommand M_MAP_THEMATIC

MapInfo.do "Set Window Legend Parent " & fMainForm.hwnd & " Show" MapInfo.do "Set Legend "

End Sub

Private Sub menuMapModifyThematic_Click()

MapInfo.RunMenuCommand M_MAP_MODIFY_THEMATIC

End Sub

Private Sub menuMapPreviousView_Click()

MapInfo.RunMenuCommand M_MAP_PREVIOUS

End Sub

Private Sub menuOpenWor_Click()

On Error Resume Next

' RightIndex = ".WOR"

'

' If (InStr(LeftRightIndex, RightIndex) <= 0) Then

' LeftRightIndex = "*.WOR"

' End If

' If (TheInPathTabOrWor = "") Then

' TheInPathTabOrWor = TheInstallPath + "tab\"

' End If

' FrmTAB.Show 1

fMainForm.dlgOpenTable.CancelError = True

fMainForm.dlgOpenTable.Filter = "MapInfo Tables (*.wor)|*.wor"

fMainForm.dlgOpenTable.FilterIndex = 1

fMainForm.dlgOpenTable.ShowOpen '* display the dialog

If Err.Number > 0 Then

Err.Clear

Exit Sub

Else

TheWorFile = fMainForm.dlgOpenTable.FileName '* get the file selected by the user

Call menuallclose_Click

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1"

MapInfo.do "Run Application """ & TheWorFile & """"

' MapInfo.do "Set Window Legend Parent " & fMainForm.picMapFrame.hwnd & " Position(6,5) Width 2 Height 2 hide"

' MapInfo.do "Set Legend "

' winID = CLng(MapInfo.Eval("FrontWindow()"))

' mapHWnd = CLng(MapInfo.Eval("WindowInfo(" & winID & "," & WIN_INFO_WND & ")"))

thereIsAMap = True

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

MapInfo.do "Set CoordSys Earth Projection 1,0"

' Call UpdateMenuAndToolbar(True)

' fMainForm.Caption = Left(TabOrWor(1), Len(TabOrWor(1)) - 4) + " Map"

UpdateMenuAndToolbar

EnabledMenuAndToolbar

End If

End Sub

Private Sub menuSaveAsWor_Click()

MapInfo.RunMenuCommand M_FILE_SAVE_WORKSPACE

End Sub

Private Sub menuTableColomnUpDate_Click()

MapInfo.RunMenuCommand M_TABLE_UPDATE_COLUMN

End Sub

Private Sub menuTableStruture_Click()

MapInfo.RunMenuCommand M_TABLE_MODIFY_STRUCTURE

End Sub

Private Sub mnucutBscCutCreate_Click()

On Error GoTo On_Error

'在数据库中加入

If thereIsAMap Then

'* there's already a map. Add this new layer to the existing map

' MapInfo.do "Add Map Layer " & tabName

'查找conf表,是否存在

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))

For I = 1 To nLayerName

layerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")

If (InStr(layerName, "割接") > 0) Then

bExistTable = True

Exit For

End If

Next I

If bExistTable Then

I = MsgBox("割接表已经打开,是否需要生成新的割接表", vbYesNo, "割接表")

If I = 6 Then

MapInfo.do "Close Table 割接"

'关表表时,要考虑这时是否还有窗口

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

If mapWinID = 0 Then

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1"

MapInfo.do "Create Table ""割接"" (bsc char(20)) file """ & App.Path & "\tab\割接.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For 割接CoordSys Earth Projection 1, 0"

MapInfo.do "map from 割接"

MapInfo.do "Set Map layer 割接Editable On"

b = MsgBox("割接表已生成", vbInformation, "割接表")

thereIsAMap = True

Else

MapInfo.do "Create Table ""割接"" (bsc char(20)) file """ & App.Path & "\tab\割接.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For 割接CoordSys Earth Projection 1, 0"

MapInfo.do "Add Map Auto Layer 割接"

MapInfo.do "Set Map layer 割接Editable On"

b = MsgBox("割接表已生成", vbInformation, "割接表")

thereIsAMap = True

End If

End If

Else

MapInfo.do "Create Table ""割接"" (bsc char(20)) file """ & App.Path & "\tab\割接.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For 割接CoordSys Earth Projection 1, 0"

MapInfo.do "Add Map Auto Layer 割接"

MapInfo.do "Set Map layer 割接Editable On"

b = MsgBox("割接表已生成", vbInformation, "割接表")

thereIsAMap = True

End If

Else

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1"

MapInfo.do "Create Table ""割接"" (bsc char(20)) file """ & App.Path & "\tab\割接.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For 割接CoordSys Earth Projection 1, 0"

MapInfo.do "map from 割接"

MapInfo.do "Set Map layer 割接Editable On"

b = MsgBox("割接表已生成", vbInformation, "割接表")

thereIsAMap = True

End If

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnucutBscCutOpen_Click()

Dim theFile As String '* the full path to the file

Dim tabName As String '* the MapInfo table alias for the file

'* First, display a common file dialog to open a table

On Error GoTo On_Error '* hitting cancel in the dlg is handled as an error

fMainForm.dlgOpenTable.Filter = "MapInfo Tables (*.tab)|*.tab"

fMainForm.dlgOpenTable.FilterIndex = 1

fMainForm.dlgOpenTable.ShowOpen '* display the dialog

theFile = fMainForm.dlgOpenTable.FileName '* get the file selected by the user

tabName = MapInfo.Eval("PathToTableName$( """ & theFile & """ )") '* get table alias

If tabName <> "割接" Then

MsgBox "这个图层不是割接图层"

Exit Sub

Else

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))

For I = 1 To nLayerName

layerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")

If (InStr(layerName, "割接") > 0) Then

bExistTable = True

Exit For

End If

Next I

If bExistTable Then

b = MsgBox("割接表已打成", vbInformation, "割接表")

Exit Sub

Else

MapInfo.do "Open Table """ & theFile & """ as " & tabName '* open the table

'MapInfo.do "Set Table " & tabName & " ReadOnly" '* make it ReadOnly

'* now, make sure the table is mappable, otherwise, display a msg and close the table

''by bwt

' If MapInfo.Eval("TableInfo(" & tabName & "," & TAB_INFO_MAPPABLE & ")") = "F" Then

' MsgBox "This table is not mappable. I can only open mappable tables."

' MapInfo.Do "Close Table " & tabName

' Exit Sub

' End If

''by bwt

'* if the table is mappable, add it to the current map OR create a new map

If thereIsAMap Then

'* there's already a map. Add this new layer to the existing map

MapInfo.do "Add Map Layer " & tabName

Else

'* no map yet. Create a new one, reparented into our picture box

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1"

MapInfo.do "Map From " & tabName

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

thereIsAMap = True

End If

End If

End If

'* we don't need to include UpdateLayerList or UpdateMenuAndToolbar here because they will '* get called by the WindowContentsChanged() method in the MIResponder object which was set

'* with MapInfo's "SetCallback" method in the "InitializeMapInfoConnection" subroutine.

' UpdateInfoClear

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnucutBscCutSta_Click()

On Error GoTo On_Error

Dim rst As New ADODB.Recordset

Dim Item As ListItem

rst.Open "delete from cutover", connaccess, adOpenStatic, adLockOptimistic

Dim str_record As String

'frmscheme.Grid_scheme.Rows = 1

MapInfo.do " Select conf.cell_id, 割接.bsc from 割接, conf where 割接.Obj Contains conf.Obj and 割接.bsc<>conf.bsc group by conf.cell_id, 割接.bsc into cutover "

MapInfo.do " fetch first from cutover "

Do While "F" = MapInfo.Eval("EOT(cutover)")

sql1 = "insert into cutover values (" & MapInfo.Eval("cutover.cell_id") & " , '" & MapInfo.Eval("cutover.bsc") & "')"

rst.Open sql1, connaccess, adOpenStatic, adLockOptimistic

MapInfo.do " fetch next from cutover"

Loop

rst.Open "select * from lasttrx和et变化", connaccess, adOpenStatic, adLockOptimistic

Load frmscheme

'Do While Not rst.EOF

' str_record = rst!msc & vbTab & rst!bsc & vbTab & rst!额定trx & vbTab & rst!现网trx & vbTab & rst!trx变化& vbTab & rst!lasttrx & vbTab & rst!额定et & vbTab & rst!现网et & vbTab & rst!et变化& vbTab & rst!lastet

' frmscheme.Grid_scheme.AddItem str_record

' rst.MoveNext

'Loop

While Not rst.EOF

Set Item = frmscheme.lvFindResult.ListItems.Add(, , rst!msc)

Item.SubItems(1) = ConvertString(rst!bsc, "")

Item.SubItems(2) = ConvertString(rst!额定trx, "")

Item.SubItems(3) = ConvertString(rst!现网trx, "")

Item.SubItems(4) = ConvertString(rst!trx变化, "")

Item.SubItems(5) = ConvertString(rst!lasttrx, "")

Item.SubItems(6) = ConvertString(rst!额定et, "")

Item.SubItems(7) = ConvertString(rst!现网et, "")

Item.SubItems(8) = ConvertString(rst!et变化, "")

Item.SubItems(9) = ConvertString(rst!lastet, "")

rst.MoveNext

Wend

frmscheme.Show 1

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnucutCreateNew_Click()

On Error GoTo On_Error

Dim sql1 As String

Dim maxtime1 As String

Dim rst As New ADODB.Recordset

Dim mapWinID As Long

Dim nLayerName As Integer

Dim layerName As String

Dim bExistTable As Boolean

'sql1 = "SELECT max(时间) AS maxtime FROM NPMDB_V_P_无线性能合计_half" 'rst.Open sql1, connaccess, adOpenStatic, adLockOptimistic

'maxtime1 = rst!maxtime

'rst.Close

If thereIsAMap Then

'* there's already a map. Add this new layer to the existing map

' MapInfo.do "Add Map Layer " & tabName

'查找conf表,是否存在

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))

For I = 1 To nLayerName

layerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")

If (InStr(layerName, "conf") > 0) Then

bExistTable = True

Exit For

End If

Next I

If bExistTable Then

I = MsgBox("基站表已经打开,是否需要生成新的基站表", vbYesNo, "基站表")

If I = 6 Then

MapInfo.do "Close Table conf"

'关表表时,要考虑这时是否还有窗口

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

If mapWinID = 0 Then

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1"

'MapInfo.Do "Register Table ""D:\vb窗体\活动窗体\database.mdb"" Type ACCESS Table ""conf"" Into ""D:\vb窗体\活动窗体\conf.TAB"""

MapInfo.do "Register Table """ & App.Path & "\database.mdb"" Type ACCESS Table ""conf"" Into """ & App.Path & "\conf.TAB"""

MapInfo.do "Open Table """ & App.Path & "\conf.TAB"" Interactive"

MapInfo.do "Create Map For conf CoordSys Earth Projection 1, 104"

MapInfo.do "update conf set obj=createpoint(经度,纬度)"

MapInfo.do "Commit Table conf Interactive"

MapInfo.do "map from conf"

MapInfo.do "Set Map Zoom Entire"

b = MsgBox("基站表已生成", vbInformation, "基站表")

thereIsAMap = True

Else

'MapInfo.Do "Register Table ""D:\vb窗体\活动窗体\database.mdb"" Type ACCESS Table ""conf"" Into ""D:\vb窗体\活动窗体\conf.TAB"""

MapInfo.do "Register Table """ & App.Path & "\database.mdb"" Type ACCESS Table ""conf"" Into """ & App.Path & "\conf.TAB"""

' MapInfo.Do "Open Table ""D:\vb窗体\活动窗体\conf.TAB"" Interactive"

MapInfo.do "Open Table """ & App.Path & "\conf.TAB"" Interactive"

MapInfo.do "Create Map For conf CoordSys Earth Projection 1, 104"

MapInfo.do "update conf set obj=createpoint(经度,纬度)"

MapInfo.do "Commit Table conf Interactive"

MapInfo.do "Add Map Auto Layer conf"

MapInfo.do "Set Map Zoom Entire"

b = MsgBox("基站表已生成", vbInformation, "基站表")

thereIsAMap = True

End If

End If

Else

'MapInfo.Do "Register Table ""D:\vb窗体\活动窗体\database.mdb"" Type ACCESS Table ""conf"" Into ""D:\vb窗体\活动窗体\conf.TAB"""

MapInfo.do "Register Table """ & App.Path & "\database.mdb"" Type ACCESS Table ""conf"" Into """ & App.Path & "\conf.TAB"""

' MapInfo.Do "Open Table ""D:\vb窗体\活动窗体\conf.TAB"" Interactive"

MapInfo.do "Open Table """ & App.Path & "\conf.TAB"" Interactive"

MapInfo.do "Create Map For conf CoordSys Earth Projection 1, 104"

MapInfo.do "update conf set obj=createpoint(经度,纬度)"

MapInfo.do "Add Map Auto Layer conf"

MapInfo.do "Set Map Zoom Entire"

b = MsgBox("基站表已生成", vbInformation, "基站表")

thereIsAMap = True

End If

Else

'* no map yet. Create a new one, reparented into our picture box

' MapInfo.do "Map From " & tabName

' mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

' thereIsAMap = True

'MapInfo.Do "Register Table ""D:\vb窗体\活动窗体\database.mdb"" Type ACCESS Table ""conf"" Into ""D:\vb窗体\活动窗体\conf.TAB"""

MapInfo.do "Register Table """ & App.Path & "\database.mdb"" Type ACCESS Table ""conf"" Into """ & App.Path & "\conf.TAB"""

'MapInfo.Do "Open Table ""D:\vb窗体\活动窗体\conf.TAB"" Interactive"

MapInfo.do "Open Table """ & App.Path & "\conf.TAB"" Interactive"

'MapInfo.do "Browse * From conf"

'MapInfo.RunMenuCommand 102 'open

MapInfo.do "Set Next Document Parent " & fMainForm.picMapFrame.hwnd & " Style 1" MapInfo.do "Create Map For conf CoordSys Earth Projection 1, 104"

MapInfo.do "update conf set obj=createpoint(经度,纬度)"

'MapInfo.RunMenuCommand 408

MapInfo.do "map from conf"

MapInfo.do "Set Map Zoom Entire"

b = MsgBox("基站表已生成", vbInformation, "基站表")

thereIsAMap = True

End If

UpdateMenuAndToolbar

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnucutCreateRegion_Click()

On Error GoTo On_Error

If thereIsAMap Then

mapWinID = CLng(MapInfo.Eval("FrontWindow()"))

nLayerName = CInt(MapInfo.Eval("MapperInfo(" & mapWinID & ",9)"))

For I = 1 To nLayerName

layerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & I & ",1)")

If (InStr(layerName, "conf") > 0) Then

bExistTable = True

Exit For

End If

Next I

If bExistTable Then

''''''''''''''''''''''''''''''''''''''''''''''''

For J = 1 To nLayerName

layerName = MapInfo.Eval("LayerInfo(" & mapWinID & "," & J & ",1)")

If (InStr(layerName, "region") > 0) Then

bExistTable1 = True

Exit For

End If

Next J

If bExistTable1 Then

I = MsgBox("边界表已经打开,是否需要生成新的基站表", vbYesNo, "边界表")

If I = 6 Then

MapInfo.do "Close Table cellregion"

MapInfo.do "Close Table msc"

MapInfo.do "Close Table lac"

MapInfo.do "Close Table bsc"

MapInfo.do "Close Table region"

MapInfo.do "Open Table """ & App.Path & "\tab\region.TAB"""

MapInfo.do "Add Map Auto Layer region"

MapInfo.do "select * from region"

MapInfo.do "Set Target On"

MapInfo.do "Create Table ""cellregion"" (cellid integer,msc integer,bsc char(10),lac integer) file """ & App.Path & "\tab\cellregion.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For cellregion CoordSys Earth Projection 1, 0"

MapInfo.do "add Map Auto Layer cellregion"

MapInfo.do "Set Map layer cellregion Editable On"

MapInfo.do "select * from conf"

MapInfo.do "Create Object As Voronoi from Selection Into Table cellregion Data msc=msc,bsc=bsc,lac=lac,cellid = cell_id"

MapInfo.do "Create Table ""msc"" (msc integer) file """ & App.Path & "\tab\msc.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For msc CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer msc"

MapInfo.do "Set Map Layer msc Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table msc Group by msc Data msc=msc"

MapInfo.do "Commit Table msc Interactive"

MapInfo.do "Create Table ""lac"" (lac integer) file """ & App.Path & "\tab\lac.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For lac CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer lac"

MapInfo.do "Set Map Layer lac Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table lac Group by lac Data lac=lac"

MapInfo.do "Commit Table lac Interactive"

MapInfo.do "Create Table ""bsc"" (bsc char(10)) file """ & App.Path &

"\tab\bsc.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For bsc CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer bsc"

MapInfo.do "Set Map Layer bsc Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table bsc Group by bsc Data bsc=bsc"

MapInfo.do "Commit Table bsc Interactive"

MapInfo.do "Commit table cellregion"

MapInfo.do "Set Map Window frontwindow() Zoom Entire"

MapInfo.do "Set Target Off"

b = MsgBox("边界表已生成", vbInformation, "基站表")

thereIsAMap = True

End If

Else

MapInfo.do "Open Table """ & App.Path & "\tab\region.TAB"""

MapInfo.do "Add Map Auto Layer region"

MapInfo.do "select * from region"

MapInfo.do "Set Target On"

MapInfo.do "Create Table ""cellregion"" (cellid integer,msc integer,bsc char(10),lac integer) file """ & App.Path & "\tab\cellregion.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For cellregion CoordSys Earth Projection 1, 0"

MapInfo.do "add Map Auto Layer cellregion"

MapInfo.do "Set Map layer cellregion Editable On"

MapInfo.do "select * from conf"

MapInfo.do "Create Object As Voronoi from Selection Into Table cellregion Data msc=msc,bsc=bsc,lac=lac,cellid = cell_id"

MapInfo.do "Create Table ""msc"" (msc integer) file """ & App.Path & "\tab\msc.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For msc CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer msc"

MapInfo.do "Set Map Layer msc Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table msc Group by msc Data msc=msc"

MapInfo.do "Commit Table msc Interactive"

MapInfo.do "Create Table ""lac"" (lac integer) file """ & App.Path & "\tab\lac.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For lac CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer lac"

MapInfo.do "Set Map Layer lac Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table lac Group by lac Data lac=lac"

MapInfo.do "Commit Table lac Interactive"

MapInfo.do "Create Table ""bsc"" (bsc char(10)) file """ & App.Path & "\tab\bsc.TAB"" TYPE NATIVE Charset ""WindowsSimpChinese"""

MapInfo.do "Create Map For bsc CoordSys Earth Projection 1, 104"

MapInfo.do "add Map Auto Layer bsc"

MapInfo.do "Set Map Layer bsc Editable On"

MapInfo.do "Create Object As Union From cellregion Into Table bsc Group by bsc Data bsc=bsc"

MapInfo.do "Commit Table bsc Interactive"

MapInfo.do "Commit table cellregion Interactive"

MapInfo.do "Set Map Window frontwindow() Zoom Entire"

MapInfo.do "Set Target Off"

b = MsgBox("边界表已生成", vbInformation, "基站表")

thereIsAMap = True

End If

'''''''''''''''''''''''''''''''''''''''''''''''''

Else

b = MsgBox("请先打开基站表", vbExclamation, "注意")

End If

Else

b = MsgBox("请先打开基站表", vbExclamation, "注意")

End If

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnuMapCreate3DMap_Click()

MapInfo.RunMenuCommand 817

End Sub

Private Sub mnucutLacCut_Click()

End Sub

Private Sub mnucutfangan_Click()

On Error GoTo On_Error

Dim strSQL As String

strSQL = "SELECT * From 生成割接方案"

Call ExporToExcel(strSQL)

Exit Sub

On_Error:

MsgBox Err.Description, vbCritical, "系统提示"

Exit Sub

End Sub

Private Sub mnuFileExit_Click()

End

End Sub

Private Sub mnuFileSave_Click()

MapInfo.RunMenuCommand M_FILE_SAVE

End Sub

Private Sub MnuMapChangeView_Click()

MapInfo.RunMenuCommand M_MAP_CHANGE_VIEW

End Sub

Private Sub mnuMapClearCosmetic_Click()

MapInfo.RunMenuCommand M_MAP_CLEAR_COSMETIC

End Sub

Private Sub mnuMapClearCustomLabels_Click()

MapInfo.RunMenuCommand M_MAP_CLEAR_CUSTOM_LABELS End Sub

Private Sub mnuMapCloseClip_Click()

MapInfo.RunMenuCommand M_MAP_CLIP_REGION_ONOFF End Sub

Private Sub mnuMapCopyView_Click()

Call LoadNewForm

mapWinID = CLng(MapInfo.Eval("FrontWindow()")) MapInfo.RunMenuCommand M_MAP_CLONE_MAPPER

End Sub

Private Sub mnuMapCreateLegend_Click()

Call LoadNewForm

MapInfo.RunMenuCommand 816

End Sub

Private Sub mnuMapEntireLayer_Click()

MapInfo.RunMenuCommand M_MAP_ENTIRE_LAYER End Sub

Private Sub mnuMapLayer_Click()

MapInfo.RunMenuCommand M_MAP_LAYER_CONTROL 'Call EnabledMenuAndToolbar

End Sub

Private Sub mnuMapOptions_Click()

MapInfo.RunMenuCommand M_MAP_OPTIONS

End Sub

Private Sub mnuMapSaveCosmetic_Click()

MapInfo.RunMenuCommand M_MAP_SAVE_COSMETIC End Sub

Private Sub mnuMapSetClip_Click()

MapInfo.RunMenuCommand M_MAP_SET_CLIP_REGION End Sub

Private Sub mnuObjects_BUFFER_Click()

MapInfo.RunMenuCommand M_OBJECTS_BUFFER

End Sub

Private Sub mnuObjects_Clear_Target_Click() MapInfo.RunMenuCommand M_OBJECTS_CLEAR_TARGET End Sub

Private Sub mnuObjects_Combine_Click()

MapInfo.RunMenuCommand M_OBJECTS_COMBINE End Sub

MapInfo.RunMenuCommand M_OBJECTS_CVT_PGON End Sub

Private Sub mnuObjects_CVT_PLINE_Click() MapInfo.RunMenuCommand M_OBJECTS_CVT_PLINE End Sub

Private Sub mnuObjects_ERASE_Click()

MapInfo.RunMenuCommand M_OBJECTS_ERASE

End Sub

Private Sub mnuObjects_ERASE_OUT_Click() MapInfo.RunMenuCommand M_OBJECTS_ERASE_OUT End Sub

Private Sub mnuObjects_OVERLAY_Click() MapInfo.RunMenuCommand M_OBJECTS_OVERLAY End Sub

Private Sub mnuObjects_Set_Target_Click() MapInfo.RunMenuCommand M_OBJECTS_SET_TARGET End Sub

Private Sub mnuObjects_SMOOTH_Click() MapInfo.RunMenuCommand M_OBJECTS_SMOOTH End Sub

Private Sub mnuObjects_SPLIT_Click()

MapInfo.RunMenuCommand M_OBJECTS_SPLIT

End Sub

Private Sub mnuObjects_unCombine_Click() MapInfo.RunMenuCommand 1621

End Sub

Private Sub mnuObjects_UNSMOOTH_Click() MapInfo.RunMenuCommand M_OBJECTS_UNSMOOTH End Sub

Private Sub mnuObjectsCheckError_Click() MapInfo.RunMenuCommand 1619

End Sub