Shape Object Script
This script demonstrates all the methods and properties in the Shape object. If you wish to run the script, open Scripter and then open ShapeObject.bas from the Surfer Samples folder.
'ShapesObject.bas illustrates the properties of the
' following objects:
' Rectangle (includes rounded rectangles, squares)
' Ellipse (includes circles)
' Symbol
' Text
' Polyline
' Polygon
' Composite
'See VariogramObject.bas, specific map object BAS files
' for examples of variogram and mapframe based objects.
'------------------------------------------------------------
Sub Main
Debug.Print "----- ShapesObject.bas - ";Time;" -----"
'Get existing Surfer instance, or create a new one If none exists.
On Error Resume Next 'Turn off error reporting.
Set SurferApp = GetObject(,"Surfer.Application")
If Err.Number<>0 Then
Set SurferApp = CreateObject("Surfer.Application")
SurferApp.Documents.Add(srfDocPlot)
End If
On Error GoTo 0 'Turn on error reporting.
SurferApp.Visible = True
SurferApp.WindowState = srfWindowStateNormal
SurferApp.Width = 600
SurferApp.Height = 400
Debug.Print "Surfer ";SurferApp.Version
SurferApp.Caption = "Surfer "+SurferApp.Version
AppActivate "Surfer "+SurferApp.Version
Set plotdoc1 = SurferApp.Documents(1)
If plotdoc1.Type <> srfDocPlot Then plotdoc1 = SurferApp.Documents.Add
Set plotwin1 = SurferApp.Windows(1)
With plotdoc1.PageSetup
.Orientation = srfLandscape
.Height = 8.5
.Width = 11
End With
plotwin1.Zoom(srfZoomPage)
path1 = SurferApp.Path+"\samples\"
Set shapes1 = plotdoc1.Shapes
shapes1.SelectAll
plotdoc1.Selection.Delete
'===============================================================
'Shape Object Properties
'The Shape Object is the base object for all graphical objects
'within the plot document. All objects derived from the
'Shape Object share the following properties and methods.
'Refer to the Rectangle Object below for examples.
'===============================================================
'===========================
'Rectangle Object Properties
'===========================
'The Rectangle object is created with the Shapes.AddRectangle method.
Debug.Print "AddRectangle"
shapes1.AddText(1,1,"AddRectangle").Font.Size = 40
Set rectangle1 = shapes1.AddRectangle( Left:=1,Top:=6, _
Right:=4, Bottom:=4)
'AppActivate "ShapeObject"
'------------------------------
'Shared Shape Object Properties
'------------------------------
Debug.Print "Shape Object Properties"
With rectangle1
Debug.Print " Rectangle height:"; .Height; ", width:"; .Width; _
", left:"; .Left; ", top:";.Top
Debug.Print " Application: "; .Application
Debug.Print " Name: "; .Name
Debug.Print " Parent: "; .Parent
AppActivate "Surfer "+SurferApp.Version
End With
Debug.Print " Current rotation angle:"; rectangle1.Rotation
rectangle1.Rotation = 30
Debug.Print " New rotation angle:"; rectangle1.Rotation
Debug.Print "Rectangle selected: "; rectangle1.Selected
Wait 1
rectangle1.Selected = True 'Property
rectangle1.Select 'Method. Same effect as Selected = True"
Debug.Print "Rectangle selected? "; rectangle1.Selected
Debug.Print "Rectangle visible? ";rectangle1.Visible
Wait 1
rectangle1.Visible = False
Debug.Print "Rectangle visible? ";rectangle1.Visible
Wait 1
rectangle1.Visible = True
'----------------------------
'Shared Shape Object methods.
'----------------------------
Set rectangle2 = shapes1.AddRectangle(Left:=3, Top:=5, _
Right:=5, Bottom:=3)
rectangle1.Fill.ForeColorRGBA.Color = srfColorRed
rectangle1.Fill.Pattern = "Solid"
rectangle2.Fill.ForeColorRGBA.Color = srfColorBlue
rectangle2.Fill.Pattern = "Solid"
rectangle2.SetZOrder(srfZOToBack)
rectangle2.Select
Debug.Print "Rectangle2 selected? ";rectangle2.Selected
Wait 1
rectangle2.Select 'or rectangle2.Selected=True
Debug.Print "Rectangle2 selected? ";rectangle2.Selected
Wait 1
rectangle2.Deselect 'or rectangle2.Selected=False
Debug.Print "Rectangle2 selected? ";rectangle2.Selected
rectangle2.Delete
Debug.Print "Rectangle2 deleted."
Wait 1
shapes1("Text").Delete
Debug.Print "AddRectangle - rounded rectangle"
shapes1.AddText(1,1,"AddRectangle - rounded rectangle").Font.Size = 40
Set roundedrect1 = shapes1.AddRectangle(Left:=5, Right:=8, _
Top:=6, Bottom:=4, xRadius:=0.5, yRadius:=0.5)
Wait 1
shapes1("Text").Delete
With rectangle1
'The Fill property returns the FillFormat object, which can
'be used to set the fill foreground color, pattern,
'background color (for vector pattern types), and
'background transparency.
Debug.Print " Fill Property"
shapes1.AddText(1,1,"Fill Property").Font.Size = 40
.Fill.ForeColorRGBA.Color = srfColorYellow
.Fill.Pattern = "Solid"
Wait 1
shapes1("Text").Delete
'The Line property returns the LineFormat object, which can
'be used to set the line foreground color, style, and width.
Debug.Print " Line Property"
shapes1.AddText(1,1,"Line Property").Font.Size = 40
.Line.ForeColorRGBA.Color = srfColorBlue
.Line.Width = 0.03
.Line.Style = "Dash Dot"
'The selected line style name is listed in the Style
'dropdown list. Use the Up and Down arrow keys to display
'each name. A complete list is in the attrib.ini file.
Wait 1
shapes1("Text").Delete
End With
'The xRadius and yRadius properties control the anount of
'rounding at the corners of the rounded rectangle.
'Units are page units (SurferApp.PageUnits), a double. These
'properties can only be specified via automation.
'There is no equivalent control in the user interface.
With roundedrect1
Debug.Print " xRadius, yRadius"
'vbCrLf is the Visual BASIC enumeration constant for the
' carriage return + line feed or chr(13) + chr(10).
shapes1.AddText(1,2, _
"Rounded Rectangle radii:"+vbCrLf+ _
" xRadius: " + .xRadius + _
", yRadius: " + .yRadius).Font.Size = 40
End With
Wait 1
shapes1.SelectAll
plotdoc1.Selection.Delete
'===========================
'Ellipse Object Properties
'===========================
'The Ellipse object is created with the Shapes.AddEllipse method.
Debug.Print "AddEllipse"
shapes1.AddText(1,1,"AddEllipse").Font.Size = 40
Set ellipse1 = shapes1.AddEllipse( Left:=1, Right:=4, _
Top:=6, Bottom:=4)
plotdoc1.Windows(1).Zoom(srfZoomPage)
Wait 1
shapes1("Text").Delete
With ellipse1
'The Fill property returns the FillFormat object, which can
'be used to set the fill foreground color, pattern,
'background color (for vector pattern types), and
'background transparency.
Debug.Print " Fill Property"
shapes1.AddText(1,1,"Fill Property").Font.Size = 40
.Fill.ForeColorRGBA.Color = srfColorYellow
.Fill.Pattern = "Solid"
Wait 1
shapes1("Text").Delete
'The Line property returns the LineFormat object, which can
'be used to set the line foreground color, style, and width.
Debug.Print " Line Property"
shapes1.AddText(1,1,"Line Property").Font.Size = 40
.Line.ForeColorRGBA.Color = srfColorBlue
.Line.Width = 0.03
.Line.Style = "Dash Dot"
'The selected line style name is listed in the Style
'dropdown list. Use the Up and Down arrow keys to display
'each name. A complete list is in the attrib.ini file.
Wait 1
shapes1.SelectAll
plotdoc1.Selection.Delete
End With
'=======================
'Symbol Object property.
'=======================
Debug.Print "Symbol Object - Marker Property"
shapes1.AddText(1,1,"Symbol Object - Marker Property").Font.Size = 40
Set sym1 = shapes1.AddSymbol(4,4)
sym1.Marker.Size =1
sym1.Marker.Index=2
Wait 1
shapes1.SelectAll
plotdoc1.Selection.Delete
'=======================
'Text Object properties.
'=======================
Debug.Print "Text Object Properties"
Set text1 = shapes1.AddText(1,1,"Text Object Properties")
text1.Font.Size = 40
Wait 1
text1.Text="Text Object - Font and Text Properties"
Wait 1
text1.Delete
'==========================
'Polyline Object Properties
'==========================
SurferApp.Caption = "Surfer " + SurferApp.Version
AppActivate "Surfer " + SurferApp.Version
Debug.Print "Polyline Object Properties"
shapes1.AddText(1,1,"Polyline Object Properties").Font.Size = 40
Dim coords(0 To 7) As Double 'double array
coordsarray = Array(4,4, 5,5, 6,4, 7,5) 'variant array
For i = 0 To 7
coords(i) = coordsarray(i)
Next i
Set polyline1 = shapes1.AddPolyLine(coords)
Wait 1
'The Line Property sets the line ForeColor, Width, and Style.
Debug.Print " Polyline Object - Line Property"
shapes1("Text").Text = " Polyline Object - Line Property"
polyline1.Line.ForeColorRGBA.Color = srfColorRed
polyline1.Line.Width = 0.1
polyline1.Line.Style = "Dash Dot"
Wait 1
Debug.Print " Polyline Object - StartArrow Property"
shapes1("Text").Text = " Polyline Object - StartArrow Property"
polyline1.StartArrow = srfASTriangle 'Arrow Style is Triangle
Wait 1
polyline1.ArrowScale = 5
Debug.Print " Polyline Object - ArrowScale Property"
shapes1("Text").Text = " Polyline Object - ArrowScale Property"
Wait 1
Debug.Print " Polyline Object - EndArrow Property"
shapes1("Text").Text = " Polyline Object - EndArrow Property"
polyline1.EndArrow = srfASSimple
Debug.Print " Polyline Object - Vertices Property"
shapes1("Text").Text = " Polyline Object - Vertices Property"
Dim verts() As Double
verts() = polyline1.Vertices
Wait 1
Debug.Print " Polyline starts at ";verts(0);", ";verts(1)
shapes1("Text").Text = " Polyline starts at"+Str(verts(0))+","+Str(verts(1))
Wait 1
shapes1.SelectAll
plotdoc1.Selection.Delete
'=========================================
'The Polygon Object Properties and Methods
'=========================================
Debug.Print "Polygon Object"
shapes1.AddText(1,1,"Polygon Object").Font.Size = 40
Dim coords2(0 To 9) As Double
coordsarray2 = Array( _
2.8, 2.2, _
3.4, 2.7, _
3.7, 2.2, _
3.5, 1.8, _
2.8, 2.2) 'Variant Array
For i = 0 To 9 'Copy Variant array to Double array.
coords2(i) = coordsarray2(i)
Next i
Set poly1 = shapes1.AddPolygon(coords2)
'The Fill property sets the fill forecolor and pattern.
poly1.Fill.ForeColorRGBA.Color = srfColorLightYellow
poly1.Fill.Pattern = "Solid"
'The Line Property sets the line forecolor, style and width.
poly1.Line.ForeColorRGBA.Color = srfColorBlue
poly1.Line.Width = 0.1
poly1.Line.Style = "Solid"
'The PolyCounts Property returns an array containing the number
'of vertices per sub-polygon (for complex polygons).
'It returns an array of longs.
Set poly1 = shapes1("Polygon")
Dim polycnts() As Long
polycnts() = poly1.PolyCounts
firstsubpoly = LBound(polycnts)
lastsubpoly = UBound(polycnts)
For i = firstsubpoly To lastsubpoly
Debug.Print " Subpolygon #";i;" has";polycnts(i);" vertices.
Next i
'The Vertices Property returns an array containing
'the coordinates of the vertices in the polygon.
'It returns an array of doubles.
Dim verts1() As Double
verts1() = poly1.Vertices
Debug.Print "Polygon Vertices"
For i = LBound(verts1) To UBound(verts1) Step 2
Debug.Print verts1(i);verts1(i+1)
Next i
Wait 1
'The SetVertices Method changes the vertices in an existing
'polygon.
Debug.Print "Change vertex #3."
shapes1("Text").Text = "Change Vertex #3"
Dim verts2() As Double
Dim polycnt2() As Long
verts2() = poly1.Vertices
polycnt2() = poly1.PolyCounts
'Vertex 3 coordinates are at indices 4 (x) and 5 (y).
Debug.Print "Old coordinates: ";verts2(4);verts2(5)
'Change the third vertex coordinates.
verts2(4) = 5
verts2(5) = 3
Debug.Print "New coordinates: ";verts2(4);verts2(5)
poly1.SetVertices( _
Vertices:=verts2(), _
PolyCounts:=polycnt2() )
Wait 1
'The Composite Object contains one or more Shape objects.
'It is created with the Selection.Combine method.
Debug.Print "Composite Object"
shapes1("Text").Text = "Composite Object"
Set rect1 = shapes1.AddRectangle(4,5,6,7)
rect1.Select
poly1.Select
Set composite1 = plotdoc1.Selection.Combine
Wait 1
'The BreakApart Method breaks a Composite Object into
'its component objects.
shapes1("Text").Text = "Break Apart"
composite1.BreakApart
End Sub