ArcGIS中AO基本函数集

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