物化探规则测网的设计点位快速计算方法

朱向荣，王龙龙

（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。