How can I use Grapher automation to plot separate histograms for a range of columns?

This article contains a sample script that a user submitted which shows how to plot separate histograms for a range of columns.

To run this script:

  1. Copy the script below, or click here to download the BAS file: MultiHistogram.BAS
  2. In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Grapher 13.
  3. Double click on Scripter.exe to launch Scripter.
  4. Press Ctrl+A to select all of the existing lines then press Delete.
  5. If you copied this script, press Ctrl+V to paste it into Scripter. If you downloaded it, click File | Open, select the BAS file from your downloads directory, and click Open.
  6. Click Script | Run to run the script.

 

OR:

  1. Copy the script below.
  2. Open Grapher and turn on the Script Manager by clicking View | Display | Script Manager.
  3. Press Ctrl+A to select all of the existing lines in the Script Manager and then press DELETE.
  4. Press Ctrl+V to paste it into the Script Manager.
  5. Click the Start/Resume icon () in the Script Manager.

*********

'########################################################################
'Code: MultiHistogram
'Application: Grapher Scripter

'Purpose: To plot separate histogram for a range of columns

'Final Graph is automatically saved in and with the name of the directory
'that contains the datafiles

'Users:	 Grapher (Golden Software)
'Original Author: Niels Hartog
'Date:	 Sep 2005 by Niels Hartog (niels.hartog+troep@gmail.com)
'Remove "+troep" when sending email

'Feel free to tune the source code to your needs
'But please leave these header lines in tact.
'Date modified:
'Modified by:
'#########################################################################



Sub Main
	Dim Grapher, Docs, Plot, WksRangeXCol, WksRangeYCol, WksRange4, wks, Graph, PageSetup As Object
	Dim r, colstart, colend, LastCol, X, SquareSide As Integer
	Dim cols, FileExt, inPath As String
	Dim xCol, yCol, zCol As Long
	Dim StartTime, GraphWidth, GraphHeight As Double

	Set Grapher = CreateObject("Grapher.Application")
	Grapher.Visible = False
	Set Docs = Grapher.Documents
	Set Plot = Docs.Add(grfPlotDoc)

'Assigns the AutoShapes collection to
'the variable named Shapes
 Dim Shapes As Object
 Set Shapes = Plot.Shapes


	inPath=GetFilePath("","dat;xls;txt;csv","","Select Data File In Target Folder") 'get full file path
	If inPath ="" Then End
	FileExt=Right(inPath,4)
	Set wks = Grapher.Documents.Open(inPath)
	LastCol = wks.UsedRange.LastColumn

Dim lists() As String
ReDim lists(r To LastCol)
	For r=1 To LastCol
    	lists$(r) = Str(r) & ": " & Str(wks.Cells(1,r))
    Next
	Begin Dialog UserDialog 200,308 ' %GRID:10,7,1,1
		Text 10,10,180,15,"Select First Data Column"
		ListBox 10,28,180,238,lists(),.list
		OKButton 80,273,40,21
	    End Dialog
	    Dim Colz1 As UserDialog
	    Colz1.list = -1
	    Dialog Colz1 ' show dialog (wait for ok)
	    colstart=Colz1.list+1
		If Str(colstart)= 0 Then
		Exit All
		End If

	Begin Dialog UserDialog 200,308 ' %GRID:10,7,1,1
		Text 10,10,180,15,"Select Last Data Column"
		ListBox 10,28,180,238,lists(),.list
		OKButton 80,273,40,21
	    End Dialog
	    Dim Colz2 As UserDialog
	    Colz2.list = -1
	    Dialog Colz2 ' show dialog (wait for ok)
	    colend=Colz2.list+1
		If Str(colend)= 0 Then
		Exit All
		End If

Debug.Print "************************************" + Str(Time) + "************************************"
StartTime=Timer

Set PageSetup = Plot.PageSetup
Debug.Print PageSetup.LeftMargin
Debug.Print PageSetup.RightMargin
Debug.Print PageSetup.width
Debug.Print Plot.PageSetup.pageSize

SquareSide = Round(IIf(Sqr(1+colend-colstart)=0,Fix(Sqr(1+colend-colstart)),1+Fix(Sqr(1+colend-colstart))))
r=colstart



		Set Graph = Shapes.AddHistogramGraph(inPath,r,Str(wks.Cells(1,r)))
		Graph.Plots(1).DisplayRelFreq = False
		'Graph.Axes(grfYAxis).AutoMax = False
		'Graph.Axes(grfYAxis).Max = 0
		'Graph.Axes(grfYAxis).Max = 1
		Graph.Axes(grfXAxis).title.text=Str(wks.Cells(1,r))
		GraphWidth=Graph.width
		GraphHeight=Graph.height
		Debug.Print "Done :" & Str(wks.Cells(1,r))
		Graph.Left = PageSetup.LeftMargin+(((r-colstart)Mod SquareSide)*(GraphWidth))
		Graph.top = (PageSetup.height-PageSetup.TopMargin)-(Fix((r-colstart)/SquareSide)*(GraphHeight))
		r=r+1

While r <=colend
		Set Graph = Shapes.AddHistogramGraph(inPath,r,Str(wks.Cells(1,r)))
		Graph.Plots(1).DisplayRelFreq = False
		'Graph.Axes(grfYAxis).AutoMax = False
		'Graph.Axes(grfYAxis).Max = 0
		'Graph.Axes(grfYAxis).Max = 1
		Graph.Axes(grfXAxis).title.text=Str(wks.Cells(1,r))
		Graph.width=GraphWidth
		Graph.height=GraphHeight
		Debug.Print "Done :" & Str(wks.Cells(1,r))
		Graph.Left = PageSetup.LeftMargin+(((r-colstart)Mod SquareSide)*(GraphWidth))
		Graph.top = (PageSetup.height-PageSetup.TopMargin)-(Fix((r-colstart)/SquareSide)*(GraphHeight))
		r=r+1
Wend
Grapher.Visible = True

Debug.Print "Done after: " & CStr(Round((Timer-StartTime),0)) & " seconds"

Debug.Print "Saved: " & Replace(inPath,FileExt,"_histogram.grf")

Plot.SaveAs(Replace(inPath,FileExt,"_histogram.grf"))


End Sub

 

Updated December 08, 2017

Was this article helpful?
0 out of 0 found this helpful

Comments

0 comments

Please sign in to leave a comment.