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:
- Copy the script below, or click here to download the BAS file: MultiHistogram.BAS
- In a Windows Explorer window, navigate to C:\Program Files\Golden Software\Grapher 13.
- Double click on Scripter.exe to launch Scripter.
- Press Ctrl+A to select all of the existing lines then press Delete.
- 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.
- Click Script | Run to run the script.
OR:
- Copy the script below.
- Open Grapher and turn on the Script Manager by clicking View | Display | Script Manager.
- Press Ctrl+A to select all of the existing lines in the Script Manager and then press DELETE.
- Press Ctrl+V to paste it into the Script Manager.
- 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
Comments
Please sign in to leave a comment.