Surfer绘制张贴图,与工程制图中点位图类似,如何实现呢,请见如下代码:
'开始调用surfer绘制张贴图
Dim SurferApp As Object
SurferApp = CreateObject("Surfer.Application")
SurferApp.Visible = True
Dim Doc As Object
Doc = SurferApp.Documents.Add(Surfer.SrfDocTypes.srfDocPlot)
Dim Plotwindow As Object
Plotwindow = Doc.Windows(1)
Plotwindow.AutoRedraw = False
Dim Shapes As Object
Shapes = Doc.Shapes
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'(1)首先在文件夹中绘制坐标点位图
Dim MapFrame As Object
MapFrame = Shapes.AddPostMap(DataFileName:='D:\Data.dat'
‘添加粘贴图,其中数据文件为: "D:\Data.dat "
Dim PostMap As Object
PostMap = MapFrame.Overlays(1)
'设置图标参数
With PostMap.Symbol
.Size = 0.1 '设置图标大小
.Color = Surfer.srfColor.srfColorPink '设置图标颜色
.Set = "GSI Default Symbols" '选择图标集
.Index = 12 '图样序号
End With
'设置标记为第三列数据
PostMap.LabCol = 3 '选择第3列
PostMap.LabelFont.Face = "Times New Roman" '字体类型
PostMap.LabelFont.Size = 3 '字体大小
PostMap.LabelPos = 1 '标记位置
PostMap.SymFrequency = 1 '标记频率
‘设置绘图范围
MapFrame.SetLimits(xMin:=XCoordinateMin, xMax:=XCoordinateMax , _
yMin:=YCoordinateMin yMax:=YCoordinateMax )
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'设置地图比例,其中MapFDXS为图件的比例,需另外设置变量,给出
Dim PostMapWidth As Single, PostMapHeight As Single
Dim MapFDXS as single=1
PostMapWidth = (XCoordinateMax - XCoordinateMin ) * MapFDXS
PostMapHeight = (YCoordinateMax - YCoordinateMin ) * MapFDXS
MapFrame.xLength = PostMapWidth
MapFrame.yLength = PostMapHeight
'修改图框
Dim Axes As Object
Axes = MapFrame.Axes
'设置图框范围
Dim AxisX1, AxisX2, AxisY1, AxisY2 As Object
'(1)设置下边框:
AxisX1 = Axes(1)
'设置边框标记
AxisX1.ShowLabels = True
AxisX1.LabelFont.Face = "Times New Roman"
AxisX1.LabelFont.Size = 10
'这里需搞清楚字体的size和width、Height的关系
'设置边框线
AxisX1.AxisLine.Width = 0.1
AxisX1.MajorTickLength = 0.2
AxisX1.SetScale(MajorInterval:=2)
'绘制网格线
'主网格线
AxisX1.ShowMajorGridLines = True '显示出来
AxisX1.MajorGridLine.ForeColor = Surfer.srfColor.srfColorBlack
AxisX1.MajorGridLine.Width = 0.01
' AxisX1.MajorGridLine.Interval = 2
'(2)设置上边框:
AxisX2 = Axes(2)
'设置边框标记
AxisX2.ShowLabels = True
AxisX2.LabelFont.Face = "Times New Roman"
AxisX2.LabelFont.Size = 10
AxisX2.SetScale(MajorInterval:=2)
'设置边框线
AxisX2.AxisLine.Width = 0.1
AxisX2.MajorTickLength = 0.2
'(3)设置左边框:
AxisY1 = Axes(3)
'设置边框标记
AxisY1.ShowLabels = True
AxisY1.LabelFont.Face = "Times New Roman"
AxisY1.LabelFont.Size = 10
AxisY1.SetScale(MajorInterval:=2)
'设置边框线
AxisY1.AxisLine.Width = 0.1
AxisY1.MajorTickLength = 0.2
'绘制网格线
AxisY1.ShowMajorGridLines = True '显示出来
'AxisY1.MajorGridLine.Style = "Solid " '可改变线型
AxisY1.MajorGridLine.ForeColor = Surfer.srfColor.srfColorBlack '改变线颜色
AxisY1.MajorGridLine.Width = 0.01
'(4)设置右边框:
AxisY2 = Axes(4)
'设置边框标记
AxisY2.ShowLabels = True
AxisY2.LabelFont.Face = "Times New Roman"
AxisY2.LabelFont.Size = 10
AxisY2.SetScale(MajorInterval:=2)
'设置边框线
AxisY2.AxisLine.Width = 0.1
AxisY2.MajorTickLength = 0.2
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'将图件上角的交点校放在(2,25)的位置上,确定基点位置:
Dim XBasePos, YBasePos As Double
XBasePos = 2
YBasePos = 25
MapFrame.Left = XBasePos - (MapFrame.Width - PostMapWidth) / 2
MapFrame.Top = YBasePos + (MapFrame.Height - PostMapHeight) / 2
某工区绘图,因坐标不方便透露,故隐藏,结果如下: