Attribute VB_Name = "GlobalFun"
''''''''''''''''''''''''''''''''''''''''''''''''''''
'模块功能 : 全局对象函数
'模块说明 :
'参数描述 :
' 创建人 :
'完成日期 :
'修改日期 :(包括修改日期,修改人,修改函数)
' 1.
' 2.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Option Explicit
'查找图层 只是在第一层中查找
Public Function FindTopLayer(strLayerName As String) As ILayer
Dim pMap As IMap
Dim pMxDoc As IMxdocument. Dim player As ILayer
Dim i As Integer
Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap
For i = 0 To pMap.LayerCount - 1
If pMap.Layer(i).Name = strLayerName Then
Set FindTopLayer = pMap.Layer(i)
Exit Function
End If
Next i
End Function
'查找grouplayer图层
Public Function FindGroupLayer(strLayerName As String) As IGroupLayer
Dim pMap As IMap
Dim pMxDoc As IMxdocument. '这里用UID的方法
Dim pEnumLayer As IEnumLayer
Dim player As ILayer
Dim pId As New UID
Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap
pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
If player.Name = strLayerName Then
Set FindGroupLayer = player
Exit Function
End If
Set player = pEnumLayer.Next
Loop
End Function
'根据指定的图层名字查找Feature图层
Public Function FindFeatureLayer(iStrLayerName As String) As IFeatureLayer
Dim pMap As IMap
Dim pMxDoc As IMxdocument. '这里用UID的方法
Dim pEnumLayer As IEnumLayer
Dim player As ILayer
Dim pId As New UID
Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap
pId.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
If player.Name = iStrLayerName Then
Set FindFeatureLayer = player
Exit Function
End If
Set player = pEnumLayer.Next
Loop
'这里是用层层递进搜索的办法
' Dim pGrouplayer As iGrouplayer
' Dim pCompositeLayer As ICompositeLayer
' Dim player As ILayer
' Dim pFeatureLayer As ILayer
' Dim i, j As Integer
'
' Set pMxDoc = g_spApp.document. ' Set pMap = pMxDoc.FocusMap
' For i = 0 To pMap.LayerCount - 1
' Set player = pMap.Layer(i)
' If TypeOf player Is IFeatureLayer Then
' If player.Name = iStrLayerName Then
' Set findfeaturelayer = player
' Exit Function
' End If
' ElseIf TypeOf player Is iGrouplayer Then
' Set pCompositeLayer = player
' For j = 0 To pCompositeLayer.count - 1
' Set pFeatureLayer = pCompositeLayer.Layer(j)
' If pFeatureLayer.Name = iStrLayerName Then
' Set findfeaturelayer = pFeatureLayer
' Exit Function
' End If
' Next j
' End If
' Next i
End Function
'保存传入的文件
Public Sub CreateLayerFile(player As ILayer, iStrPath As String)
Dim pGxLayer As IGxLayer, pFile As IGxFile
Set pGxLayer = New GxLayer
Set pFile = pGxLayer
Set pGxLayer.Layer = player
pFile.path = iStrPath + ".shp"
pFile.Save
pFile.path = iStrPath + ".shx"
pFile.Save
pFile.path = iStrPath + ".dbf"
pFile.Save
End Sub
'创建数据库连接,并进行SQL查询
Public Function OpenQuery(connectstr As String, SQLstr As String) As adodb.Recordset
On Error GoTo ErrPlace
Dim m_connect As New adodb.Connection
Dim m_command As adodb.Command
Dim mrecordset As adodb.Recordset
Set m_command = New adodb.Command
Set m_connect = New adodb.Connection
m_connect.Open connectstr
m_command.ActiveConnection = m_connect
m_command.CommandType = adCmdText
m_command.CommandText = SQLstr
Set OpenQuery = m_command.Execute
Set m_connect = Nothing
Set m_command = Nothing
Exit Function
ErrPlace:
FrmQuerryCondition.ProgressBarStep.Visible = False
FrmQuerryCondition.Label3.Caption = ""
Set OpenQuery = Nothing
End Function
'打开记录集
Public Function OpenRec(connectstr As String, SQLstr As String) As adodb.Recordset
Dim m_connect As adodb.Connection
Dim mrecordset As adodb.Recordset
Set m_connect = New adodb.Connection
Set mrecordset = New adodb.Recordset
m_connect.Open connectstr
mrecordset.Open SQLstr, m_connect, adOpenKeyset, adLockOptimistic
Set OpenRec = mrecordset
End Function
'得到半径最大值
Public Function GetMaxNumb(ByRef arr() As Double, ByRef arrAlfa() As Double) As Double
Dim i As Integer
Dim j As Integer
Dim temp As Double
Dim value_i As Double
Dim value_j As Double
For i = 0 To UBound(arr) - 2
If (arrAlfa(i) Mod 90 = 0) Then
value_i = arr(i)
Else
value_i = Abs(arr(i) / Cos(arrAlfa(i) * pi / 180))
End If
For j = i + 1 To UBound(arr) - 1
If (arrAlfa(j) Mod 90 = 0) Then
value_j = arr(j)
Else
value_j = Abs(arr(j) / Cos(arrAlfa(j) * pi / 180))
End If
If value_i < value_j Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
temp = arrAlfa(i)
arrAlfa(i) = arrAlfa(j)
arrAlfa(j) = temp
End If
Next j
Next i
If (arrAlfa(0) Mod 90 = 0) Then
GetMaxNumb = arr(0)
Else
GetMaxNumb = Abs(arr(0) / Cos(arrAlfa(0) * pi / 180))
End If
End Function
'根据图层名字显示指定图层
Public Function ShowAppointLayer(strLayerName As String) As Boolean
Dim pMap As IMap
Dim pMxDoc As IMxdocument. '这里用UID的方法
Dim pEnumLayer As IEnumLayer
Dim player As ILayer
Dim pId As New UID
Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap
'对GroupLayer图层进行操作
'设置GroupLayer图层为可见
pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
player.Visible = True
Set player = pEnumLayer.Next
Loop
'对Featurelayer图层进行操作
pId.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
player.Visible = False
If player.Name = strLayerName Then
player.Visible = True
player.MinimumScale = 0
End If
Set player = pEnumLayer.Next
Loop
' 刷新地图
Dim pActiveView As IActiveView
Set pActiveView = pMxDoc.ActivatedView
pActiveView.Refresh
pMxDoc.UpdateContents
End Function
'图层控制,根据字符串树组控制图层的显示状态
Public Function ShowAppointLayers(strLayerName() As String) As Boolean
Dim pMap As IMap
Dim pMxDoc As IMxdocument. '这里用UID的方法
Dim pEnumLayer As IEnumLayer
Dim player As ILayer
Dim pId As New UID
Dim i As Integer
Set pMxDoc = g_spApp.document. Set pMap = pMxDoc.FocusMap
'对GroupLayer图层进行操作
'设置GroupLayer图层为可见
pId.value = "{EDAD6644-1810-11D1-86AE-0000F8751720}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
player.Visible = True
Set player = pEnumLayer.Next
Loop
'对Featurelayer图层进行操作
pId.value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
Set pEnumLayer = pMap.Layers(pId, True)
pEnumLayer.Reset
Set player = pEnumLayer.Next
Do While Not player Is Nothing
player.Visible = False
For i = 0 To UBound(strLayerName, 1)
If player.Name = strLayerName(i) Then
player.Visible = True
player.Min
