overlaymapscalelimits.bas

Surfer是地学中常用的一个软件

'OverlayMapScaleLimits.bas overlays all maps in the current window
' keeping the scale, limits, and position of the selected map.
' TB - 15 Feb 02
Sub Main
	Debug.Print "----- ";Time;" -----"
	Set surf = GetObject(,"surfer.application")
	Set plotdoc1 = surf.ActiveDocument
	surf.Caption = "Surfer "+surf.Version
	AppActivate "Surfer "+surf.Version
	Debug.Print plotdoc1.Selection.Count;" object(s) selected."
	If plotdoc1.Selection.Count <> 1 Then
		MsgBox("Select one map." + vbCrLf + _
			Trim(Str(plotdoc1.Selection.Count)) + _
			" objects selected.")
		End
	End If		
	With plotdoc1.Selection(1)
		If .Type <> srfShapeMapFrame Then
			MsgBox ("Select one map.")
			End
		End If
		mapxmin = .xMin
		mapxmax = .xMax
		mapymin = .yMin
		mapymax = .yMax
		mapxscale = .xMapPerPU
		mapyscale = .yMapPerPU
		'mapzscale = .zMapPerPU
		maptop = .Top
		mapleft = .Left
	End With
	
	For Each obj In plotdoc1.Shapes
		If obj.Type = srfShapeMapFrame Then 
			If (obj.xMin >= mapxmax Or _
		  	obj.xMax <= mapxmin Or _
		  	obj.yMin >= mapymax Or _
		  	obj.yMax <= mapymin) Then
		  		plotdoc1.Selection.DeselectAll
		  		obj.Select
					If MsgBox(obj.Name + ":" +obj.Overlays(1) + _
						" is not within the limits of the reference map.  Continue?" + vbCrLf + _
						"Reference Map          "+obj.Name+":"+obj.Overlays(1) +vbCrLf + _
						"xMin:" + Str(mapxmin) + "                    xMin:"+ Str(obj.xMin), _
						vbYesNo) = vbNo Then End
			End If
		End If					
	Next		
			
	plotdoc1.Shapes.SelectAll
	Set mapframe2 = plotdoc1.Selection.OverlayMaps
	plotdoc1.Selection.DeselectAll
	mapframe2.Select
	With mapframe2
		.SetLimits(mapxmin,mapxmax,mapymin,mapymax)
		.xMapPerPU = mapxscale
		.yMapPerPU = mapyscale
'		.zMapPerPU = mapzscale
		.Top = maptop
		.Left = mapleft
	End With

End Sub