物化探規則測網的設計點位快速計算方法

朱向榮，王龍龍

（1.武警黃金第八支隊，新疆 烏魯木齊 830057）

物化探規則測網的設計點位快速計算方法

朱向榮1，王龍龍1

（1.武警黃金第八支隊，新疆 烏魯木齊 830057）

討論了如何利用Excel表格快速計算物化探規則測網的設計點位，并將計算成果輸出為全站儀或RTK數據。該方法自動化程度高、高效、準確。

Excel VBA；物化探；規則測網；設計點位；計算方法

目前，地質勘查單位越來越重視物化探成果在地質找礦中的作用，物化探技術人員的工作量也相應增加。對物化探技術人員來說，如何快速獲取物化探測網（本文主要指規則測網）的設計點位數據是急需解決的問題。對正東西向、正南北向的規則測網在Excel表格中比較容易處理，其他方向的規則測網則相對復雜。本文介紹了如何在Excel中通過VBA程序快速解決這一問題，為物化探技術人員提供一個物化探規則測網的設計點位快速計算方法。

1 規則測網點位計算模型

規則測網點位計算的數學模型并不復雜，主要是極坐標計算，圖1為某礦區測網示意圖（與地質勘探網重合），已知基線點J0坐標（X0、Y0）、基線方位R（按照剖面方向左西右東的原則，當恰為南北向時則左北右南[1]，物化探點線編號應由南向北、由西向東遞增[2]，所以0°＜R≤180°）、設計線距J、最小線距C、設計點距G、線號N、點號P（通常是每隔10 m一個點號）、最小點號K、最小點號距基線距離L（最小點號如在基線前進方向左側，則取正值，否則取負值），則可根據以下公式推算出任意測點的點位坐標（XP、YP）。當線號為單數時有以下公式：

圖1 測網示意圖

當線號為雙數時有以下公式：

式中，P=K+（i-1）×G/10（i為某測線上設計點位的自然數編號）。

2 建立Excel模板

2.1 創建Excel表格

新建工作簿，包含2個工作表，分別取名“網點設計”、“測點坐標”。如圖2所示，在“網點設計”表格中輸入相關內容，將單元格C2～O2及C5～O5設置為“允許用戶編輯區域”；在表格右上方插入兩圖片作為控件，其中一個控制計算程序，另一個調用幫助文件。表格成型后設置密碼保護表格。

圖2 網點設計

2.2 控件代碼[3]

以下代碼均在Excel2003中編制并調試通過。

Private Sub 幫助()

幫助文件.Show

End Sub

Sub 計算()

Sheets("網點設計").Select

Range("C5").Select

N = ActiveCell.Offset(0, 7).Range("A1") + ActiveCell.Offset(0, 8).Range("A1") + 1

A = ActiveCell.Offset(0, 1).Range("A1") 'X0

B = ActiveCell.Offset(0, 2).Range("A1") 'Y0

R=HD(ActiveCell.Offset(0, 3).Range("A1")) 'R0(此處所用自定義函數請參考文獻[4]

H = ActiveCell.Offset(0, 7).Range("A1") '單號數

J = ActiveCell.Offset(0, 5).Range("A1") '設計線距

C = 2 * J / ActiveCell.Offset(0, 4).Range("A1") '線號間隔

E = H * C-1 '單號最大

F = ActiveCell.Offset(0, 8).Range("A1") * C '雙號最大

G = ActiveCell.Offset(0, 9).Range("A1") '點距

S = ActiveCell.Offset(0, 6).Range("A1") '線長

K = ActiveCell.Offset(0, 10).Range("A1") '最小點號

L = ActiveCell.Offset(0, 11).Range("A1") '最小點號距基線點位置

T = ActiveCell.Offset(0, 12).Range("A1") '極距

If T = 0 Then

D = S / G + 1 '點數

Else

D = S / G + 3 '點數

End If

Sheets("測點坐標").Select

Range("A4:F65536").Select

Selection.ClearContents

For i = 1 To N

If i ＜ H + 1 Then

NN = (H -i + 1) * C - 1 '線號

X = A + ((H-i+ 1) * J) * Cos(R + WorksheetFunction. Pi())-L * Cos(R + WorksheetFunction.Pi() / 2)

Y = B + ((H - i + 1) * J) * Sin(R + WorksheetFunction. Pi())-L * Sin(R + WorksheetFunction.Pi() / 2)

Else

NN = (i - H - 1) * C

X = A + ((i-H-1) * J) * Cos(R)-L * Cos(R + WorksheetFunction.Pi() / 2)

Y = B + ((i-H-1) * J) * Sin(R)-L * Sin(R + WorksheetFunction.Pi() / 2)

End If

If T = 0 Then

For M = 1 To D

KK = K + (M-1) * G / 10

V = NN & KK

Sheets("測 點 坐 標").Cells(M + (i-1) * D + 3, 1).Value = V

Sheets("測點坐標").Cells(M + (i-1) * D + 3, 2). Value = Round(X + (M-1) * G * Cos(R - Worksheet Function.Pi() / 2), 3)

Sheets("測點坐標").Cells(M + (i-1) * D + 3, 3). Value = Round(Y + (M-1) * G * Sin(R-Worksheet Function.Pi() / 2), 3)

Next M

Else

V = NN & "S"

Sheets("測點坐標").Cells((i - 1) * D + 4, 1).Value = V

Sheets("測點坐標").Cells((i-1) * D + 4, 2).Value = Round(X + T * Cos(R + WorksheetFunction.Pi() / 2), 3)

Sheets("測點坐標").Cells((i-1) * D + 4, 3).Value = Round(Y + T * Sin(R + WorksheetFunction.Pi() / 2), 3)

For M = 2 To D - 1

KK = K + (M-2) * G / 10

V = NN & KK

Sheets("測 點 坐 標").Cells(M + (i-1) * D + 3, 1).Value = V

Sheets("測點坐標").Cells(M + (i - 1) * D + 3, 2). Value = Round(X + (M-2) * G * Cos(R-Worksheet Function.Pi() / 2), 3)

Sheets("測點坐標").Cells(M + (i-1) * D + 3, 3). Value = Round(Y + (M-2) * G * Sin(R-Worksheet Function.Pi() / 2), 3)

Next M

V = NN & "N"

Sheets("測點坐標").Cells(i * D + 3, 1).Value = V

Sheets("測 點 坐 標 ").Cells(i * D + 3, 2).Value = Round(X + (T + S) * Cos(R - WorksheetFunction.Pi() / 2), 3)

Sheets("測 點 坐 標 ").Cells(i * D + 3, 3).Value = Round(Y + (T + S) * Sin(R - WorksheetFunction.Pi() / 2), 3)

End If

Next i

N = N * D

Dim Path1 As String, Path2 As String, Path3 As String

Path1 = ActiveWorkbook.FullName

Path2 = "拓普康全站儀上傳數據.txt"

Open Path2 For Output As #1

For i = 1 To N

Sheets("測點坐標").Select

Range("A3").Select

A = ActiveCell.Offset(i, 0).Range("A1")

B = ActiveCell.Offset(i, 1).Range("A1")

C = ActiveCell.Offset(i, 2).Range("A1")

E = A & "," & C & "," & B & ",0"

Print #1, E

Next i

Close #1

Path3 = "中海達RTK放樣點庫.skl" [5]

Open Path3 For Output As #1

Print #1, "Stake points [Ver:2]"

For i = 1 To N

Sheets("測點坐標").Select

Range("A3").Select

A = ActiveCell.Offset(i, 0).Range("A1")

B = ActiveCell.Offset(i, 1).Range("A1")

C = ActiveCell.Offset(i, 2).Range("A1")

E = A & "," & B & "," & C & ",,,"

Print #1, E

Next i

Close #1

MsgBox "全站儀及RTK上傳數據已成功導出至默認文件位置！", 48

End Sub

3 Excel模板的使用注意事項

當物化探規則測網與礦區地質勘探線重合時，線號一般采用勘探線號，并按勘探線參數輸入相關數據；如果不采用，則將單號線數設為0，并按習慣設置最小線距，如果用實際距離作為線號，最小線距應設為2 m。注意本文規定點號為每隔10 m一個，這樣可以方便地知道該點在測線上的位置。在網點設計表格中將相關參數輸入后單擊第一個控件，程序即自動計算并將結果填入測點坐標表格中，同時在Excel默認位置生成拓普康全站儀上傳數據．txt、中海達RTK放樣點庫．skl兩個文件。如果需要將計算結果輸出為手持GPS儀的交換格式文件，則參照文獻[6-7]。如需驗證參數設置是否準確、計算結果是否可靠，可利用Section軟件將計算結果投影至所用地質圖件上檢核。

4 結 語

本文方法已經在多個礦區成功應用，具有自動化程度高、高效、準確的特點，即使不熟悉工程測量計算的物化探技術人員也能快速計算出規則測網的設計點位坐標。

[1] GB/T 18341-2001．地質礦產勘查測量規范[S]．

[2] DZ/T 0153-1995．物化探工程測量規范[S]．

[3] 王成春,蕭雅云．Excel VBA 2003程序設計實例導航[M]．北京:中國鐵道出版社,2005

[4] 朱向榮．基于Excel VBA的常用測量計算問題解決方案[J]．地理空間信息,2013,11(5):131-133

[5] Hi-RTK手簿軟件使用說明書[M]．廣州:中海達測繪儀器有限公司,2012

[6] 朱向榮．手持GPS儀改正參數的內業確定方法[J]．地理空間信息,2014,12(4):136-138

[7] 朱向榮．手持GPS儀點位數據的批量導入方法[J]．地理空間信息,2014,12(5):107-109

本刊聲明

為適應我國信息化建設，擴大本刊及作者知識信息交流渠道，本刊數據已被《中國核心期刊（遴選）數據庫》《CNKI 中國期刊全文數據庫》和《中文科技期刊數據庫（全文版）》等收錄。在《地理空間信息》發表的論文均默認將其在著作權保護期內的復制權、發行權、匯編權、翻譯權以及網絡傳播權授權給《地理空間信息》編輯部，編輯部可將上述權利轉授給第三方使用。作者不再許可他人以任何形式使用該篇論文，但可以在其后續作品中引用（或翻譯）該論文中部分內容或將其匯編在作者的非期刊類文集中。如不同意，請事先聲明，本刊另作處理。其文章的著作權使用費與本刊稿酬一次性給付（已在收取發表費時折減和換算為雜志贈閱）。

（本刊編輯部）

P258

B

1672-4623（2016）06-0089-03

10.3969/j.issn.1672-4623.2016.06.029

朱向榮，工程師，主要從事工程測量工作。

2014-09-11。