1 背景

這段時(shí)間被督導(dǎo)搞毛了，天天找我要一個(gè)兩個(gè)站的TAC，我說(shuō)你能不能把本期要建設(shè)的都給我一起來(lái)規(guī)劃，他說(shuō)不能。。。我也不想總被這么吵啊，畢竟我很忙的，那就寫個(gè)工具吧，so easy!

2 成品

導(dǎo)入polygon文件，輸入經(jīng)緯度，執(zhí)行獲取點(diǎn)所在的polygon。

3 實(shí)現(xiàn)過程

3.1 獲取polygon

最原始的方法，自己動(dòng)手挨個(gè)畫，當(dāng)然我肯定不會(huì)去做這么low的事，我肯定先百度，果不其然

https://wenku.baidu.com/view/7721aca00066f5335b81218d.html

很簡(jiǎn)單的方法，但這樣出來(lái)的邊界區(qū)并不精確，正常的TAC區(qū)應(yīng)該依街區(qū)、河流、山體等自然因素而定，沒關(guān)系，我們?cè)谶@個(gè)基礎(chǔ)上再修改就是了。

隨后點(diǎn)表-導(dǎo)出-mif，一份完整的polygon文件就出爐了，mif文件記錄位置信息，mid文件記錄字段信息，結(jié)構(gòu)如下：

 3.2 算法原理

1、理論支持：如果從需要判斷的點(diǎn)出發(fā)的一條射線與該多邊形的焦點(diǎn)個(gè)數(shù)為奇數(shù)，則該點(diǎn)在此多邊形內(nèi)，否則該點(diǎn)在此多邊形外。
2、編程思路：
該程序的思路是從A點(diǎn)出發(fā)向左做一條水平射線（平行于x軸，向X軸的反方向），判斷與各邊是否有焦點(diǎn)。
dLon1, dLon2, dLat1, dLat2分別表示邊的起點(diǎn)和終點(diǎn)的經(jīng)度和緯度（x軸和y軸）。
先判斷A點(diǎn)是否在邊的兩端點(diǎn)d1和d2的水平平行線之間，不在則不可能有交點(diǎn)，繼續(xù)判斷下一條邊。
在之間則說(shuō)明可能與A點(diǎn)向左的射線有交點(diǎn)，接下來(lái)利用幾何方法得到A點(diǎn)的水平直線與該邊交點(diǎn)的x坐標(biāo)。
然后判斷交點(diǎn)的x坐標(biāo)在A點(diǎn)的左側(cè)還是右側(cè)，左側(cè)則總交點(diǎn)數(shù)加一，右側(cè)則不在A點(diǎn)左射線上，繼續(xù)判斷下一條邊。

繼續(xù)搬運(yùn)工

https://blog.csdn.net/bluehawksky/article/details/51669994

大神是用Python寫的，對(duì)我們網(wǎng)優(yōu)er來(lái)說(shuō)，vba顯然使用更便捷，改改就好了，編程語(yǔ)言無(wú)所謂，反正我全靠CTRL+CV。

4 我的代碼

Sub mif()
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .InitialFileName = ThisWorkbook.Path
        .Filters.Add "Mif Files", "*.mif"
        .Filters.Add "All Files", "*.*"
        If .Show = -1 Then
            Path = .SelectedItems(1)
            Sheets("Polygon").Range("F1") = Path
        Else
            Exit Sub
        End If
    End With
End Sub
Function chkRow(s) As Boolean
    Dim c As Range, reg
    Set reg = CreateObject("vbscript.regexp")
    reg.Pattern = "^(\d+(\.\d+)?)[ ](\d+(\.\d+)?)"
    chkRow = reg.Test(s)
End Function
Sub main()
With Sheets("Polygon")
    If .Range("F1") = "" Then Exit Sub
    Path = .Range("F1")
    m = 0
    n = 0
    i = -1
    Dim midArr() As String
    Dim textArr() As String
    Dim lonArr() As String
    Dim latArr() As String
    Open Replace(Path, ".MIF", ".MID") For Input As #1
        Do Until EOF(1)
            Line Input #1, textLine
            ReDim Preserve midArr(m + 1)
            midArr(m) = Replace(Split(textLine, ",")(0), """", "")
            m = m + 1
        Loop
    Close #1
    Open Path For Input As #1
        Do Until EOF(1)
            Line Input #1, textLine
            If textLine = "Region  1" Then
                i = i + 1
            End If
            If chkRow(textLine) = True Then
                ReDim Preserve textArr(n + 1)
                ReDim Preserve lonArr(n + 1)
                ReDim Preserve latArr(n + 1)
                textArr(n) = midArr(i)
                lonArr(n) = Split(textLine, " ")(0)
                latArr(n) = Split(textLine, " ")(1)
                n = n + 1
            End If
        Loop
    Close #1
    For j = 3 To .Range("B1000000").End(xlUp).Row  '遍歷點(diǎn)
        aLon = .Cells(j, 2) * 1
        aLat = .Cells(j, 3) * 1
        iSum = 0
        For k = 0 To n - 1   '遍歷polygon頂點(diǎn)
            If textArr(k) = textArr(k + 1) Then
                pLon1 = Val(lonArr(k))
                pLat1 = Val(latArr(k))
                pLon2 = Val(lonArr(k + 1))
                pLat2 = Val(latArr(k + 1))
                If ((aLat >= pLat1) And (aLat < pLat2)) Or ((aLat >= pLat2) And (aLat < pLat1)) Then
                    If (Abs(pLat1 - pLat2) > 0) Then
                        pLon = pLon1 - ((pLon1 - pLon2) * (pLat1 - aLat)) / (pLat1 - pLat2)
                        If (pLon < aLon) Then
                            iSum = iSum + 1
                        End If
                    End If
                End If
            ElseIf textArr(k) <> textArr(k + 1) Or k - n = 2 Then
                If iSum Mod 2 <> 0 Then
                    .Cells(j, 4) = textArr(k)
                    Exit For
                Else
                    .Cells(j, 4) = "N/A"
                End If
            End If
        Next
    Next
End With
MsgBox "完成！"
End Sub

5 小結(jié)

作為網(wǎng)優(yōu)，幾乎每天都在和經(jīng)緯度打交道，mapinfo、arcgis、googleearth、高德、百度等等等等，提高生產(chǎn)效率，從熟練工具開始，我將分N篇文章，將我的經(jīng)驗(yàn)，我遇到的坑，一一記錄下來(lái)。