hexagon logo
Register Sign in
  • Replies 13 replies
  • Subscribers 221 subscribers
  • Views 298 views
  • Users 0 members are here
Options
Related

Script help

A-machine-insp
I'm at my new job and I need some help with a script we have written into every program. The script saves results as an Excel doc but it saves it to wherever the program is running from so we have these docs saved on multiple different computers. Part of my new job is organizing all of our digital data so I am making jobs folders for each part on the network and I want to direct the script to save the Excel doc there instead of on the local computer. Now... I am no expert in scripting (I really have no experience with it) so if someone would be willing to look through this and help me with changes, it would be much appreciated. The company and I both know that the script in each program would have to be changed and there is no issues with me spending the time to do it. 

Sub Main (strVariable As String, reasonVar As String)


'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim fs As Object
Dim ReportDim As String
Dim CheckDim As String


'Check To see If results file exists
FilePath = "C:\Excel Data\" '.xlsm And .bas files location
DataPath = App.ActivePartProgram.Path 'program location path
Set fs = CreateObject("Scripting.FileSystemObject")
ResFileExists = fs.fileexists(DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm") 'check program folder For .xlsm file


'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
If ResFileExists = False Then
TempFilename = FilePath & "Loop Template Column.xlsm"
Else
TempFilename = DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm"
End If
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlSheet = xlWorkbook.Worksheets("Sheet1")


If ResFileExists = False Then
RCount=6
CCount=3
xlSheet.Range("B1").Value = Part.PartName
xlSheet.Range("E4").Value = Date() & " " & Time()
xlSheet.Range("D1").Value = strVariable
xlSheet.Range("C2").Value = reasonVar



For Each Cmd In Cmds
'Eliminate DATDEF's
If Cmd.Type <> 1299 Then
'Do Dimensions
If Cmd.IsDimension Then
If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
Set DcmdID = Cmd.DimensionCommand
DimID = DcmdID.ID
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
End If
If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
Set DCmd = Cmd.DimensionCommand
CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If CheckDim <> "" Then
ReportDim = CheckDim
End If
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
If DCmd.ID = "" Then
xlSheet.Cells(RCount,4).Value = DimID & " . "& DCmd.AxisLetter
Else
xlSheet.Cells(RCount,4).Value = DCmd.ID & " . " & "M"
End If
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
'Measured Or Deviation With check For True Position
If DCmd.AxisLetter <> "TP" Then
xlSheet.Cells(RCount,5).Value = DCmd.Measured
Else
xlSheet.Cells(RCount,5).Value = DCmd.Deviation
End If
'Add Min/Max For Profile dimensions
If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
RCount=RCount+1
xlSheet.Cells(RCount,4).Value = DCmd.ID & "." & "Max"
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
xlSheet.Cells(RCount,5).Value = DCmd.Max
RCount=RCount+1
xlSheet.Cells(RCount,4).Value = DCmd.ID & "." & "Min"
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
xlSheet.Cells(RCount,5).Value = DCmd.Min
End If
RCount=RCount+1
End If
End If
End If
'Do GDT
If Cmd.Type = 184 Then
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
xlSheet.Cells(RCount,4).Value = Cmd.GetText (ID, 0) & "." & "FCF"
xlSheet.Cells(RCount,1).Value = "0"
xlSheet.Cells(RCount,2).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
xlSheet.Cells(RCount,3).Value = "0"
xlSheet.Cells(RCount,5).Value = Cmd.GetText (LINE2_DEV, 1)
RCount=RCount+1
End If
End If
End If
Next Cmd


Else

'Find first Open column.
CCount=5
Found=0
Do Until Found = 1
CCount = CCount + 1
If xlSheet.Cells(4,CCount).Value = "" Then
Found=1
End If
Loop

xlSheet.Cells(4,CCount).Value = Date() & " " & Time()
xlSheet.Cells(5,CCount).Value = " Part " & CCount - 4

'Fill In measured data
RCount = 6
For Each Cmd In Cmds
'Eliminate DATDEF's
If Cmd.Type <> 1299 Then
'Do Dimensions
If Cmd.IsDimension Then
If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
Set DcmdID = Cmd.DimensionCommand
DimID = DcmdID.ID
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
End If
If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
Set DCmd = Cmd.DimensionCommand
CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If CheckDim <> "" Then
ReportDim = CheckDim
End If
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
'Measured Or Deviation With check For True Position
If DCmd.AxisLetter <> "TP" Then
xlSheet.Cells(RCount,CCount).Value = DCmd.Measured
Else
xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation
End If
'Add Min/Max For Profile dimensions
If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
RCount=RCount+1
xlSheet.Cells(RCount,CCount).Value = DCmd.Max
RCount=RCount+1
xlSheet.Cells(RCount,CCount).Value = DCmd.Min
End If
Rcount=Rcount+1
End If
End If
End If
'Do GDT
If Cmd.Type = 184 Then
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
xlSheet.Cells(RCount,CCount).Value = "0"
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
xlSheet.Cells(RCount,CCount).Value = "0"
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
RCount=RCount+1
End If
End If
End If
Next Cmd
End If


'Save And Cleanup
Set xlSheet = Nothing
SaveName = DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm"
If ResFileExists = False Then
xlWorkBook.SaveAs SaveName
Else
xlWorkBook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing
xlWorkbooks.Close
Set xlWorkbooks = Nothing
xlApp.Quit
Set xlApp = Nothing

LabelEnd:

End Sub
  • Datapath is the path being used to store the file to.
  • Datapath is the path being used to store the file to.

    So would I need to just change these 2 lines to the location I want it saved at? 

    FilePath = "C:\Excel Data\" '.xlsm And .bas files location
DataPath = App.ActivePartProgram.Path 'program location path


  • So would I need to just change these 2 lines to the location I want it saved at? 

    FilePath = "C:\Excel Data\" '.xlsm And .bas files location
DataPath = App.ActivePartProgram.Path 'program location path

    FilePath seems to be the location of a blank template that measurement data is being added to. It looks like the script is looking for previous runs of the same part. If the current execution is the first time that part had been measured, it will open that template and make a copy in the same folder as the part is being run from. From there it will add measurement data. If you want a centralized location to read/write files to/from on the network, you will want to copy over the template file named "Loop Template Column.xlsm" to that new location and update the path in your script.

    Also, DataPath is a variable used to find the path that the current measuring routine is being run from. If you want all the reports to go to the same place, change that to a direct assignment rather than getting the location of the current measuring routine. The line would look something like:

    DataPath = "\\SomePlaceOnNetwork\ReportsOrSomething\ " 'Location of Reports on Network
  • Got it figured out. I changed the file path and data path. Since we want each report to go to it's own specific place, I have to have a unique script for each program. It's easy enough to copy and paste the BAS file to each folder so I don't mind. I have to review each program as it comes through anyways so I can change the script callout in the code without a problem.
  • in reply to A-machine-insp
    I'm glad you figured it out! It would probably be easier in the long run to have one script and make the file path an argument passed in from the measurement routine. If you make a bunch of copies of the script with little tweaks, and then down the road want to add some functionality or otherwise change the script, you'll be in for a boatload of work updating them all.
  • in reply to A-machine-insp
    The way the script was, it saved the excel to the location of the program because all of the programs were on one computer. We have 2 CMMs and put all programs from both computers on the network as well as where the reports are saved. Because of that, I want the programs automatically saved to the network instead of where the program is being ran from (C drive) so how can I add an argument to the script/program to get it to save where I want it and just use one script?
  • At the moment the script has two arguments passed in from PC-Dmis... 

    Sub Main (strVariable As String, reasonVar As String)


    To read in the DataPath & FilePath as additional arguments you would just add a third for the DataPath and a fourth for the FilePath... 
    Sub Main (strVariable As String, reasonVar As String, DataPath As String, FilePath As String)


    and remove the 
    FilePath = "C:\Excel Data\" '.xlsm And .bas files location
DataPath = App.ActivePartProgram.Path 'program location path


    lines from your script.

    In PC-Dmis, just go to the Basic Script command put the cursor in between the two commas after the second argument. Either type in the explicit DataPath eclosed between "" or type the name of a string variable that contains that information so that it would look something like this.... 

    CS1 =SCRIPT/FILENAME= C:\USERS\PUBLIC\DOCUMENTS\HEXAGON\PC-DMIS\2022.1\TEST.BAS
FUNCTION/Main,SHOW=YES,ARG1="A",ARG2="B",ARG3="C:\My_DataPa th_Folder\",,
STARTSCRIPT/


    Then do the same to add a fourth argument for your FilePath information.
  • At the moment the script has two arguments passed in from PC-Dmis... 

    Sub Main (strVariable As String, reasonVar As String)


    To read in the DataPath & FilePath as additional arguments you would just add a third for the DataPath and a fourth for the FilePath... 
    Sub Main (strVariable As String, reasonVar As String, DataPath As String, FilePath As String)


    and remove the 
    FilePath = "C:\Excel Data\" '.xlsm And .bas files location
DataPath = App.ActivePartProgram.Path 'program location path


    lines from your script.

    In PC-Dmis, just go to the Basic Script command put the cursor in between the two commas after the second argument. Either type in the explicit DataPath eclosed between "" or type the name of a string variable that contains that information so that it would look something like this.... 

    CS1 =SCRIPT/FILENAME= C:\USERS\PUBLIC\DOCUMENTS\HEXAGON\PC-DMIS\2022.1\TEST.BAS
FUNCTION/Main,SHOW=YES,ARG1="A",ARG2="B",ARG3="C:\My_DataPa th_Folder\",,
STARTSCRIPT/


    Then do the same to add a fourth argument for your FilePath information.

    What I'm thinking, after studying this for a minute, is that I can put the BAS and the file at the filepath location in the same place, leave the filepath in the script at one location then add the datapath as a string and add the datapath location as ARG3. Am I correct?

    The file at the filepath location is an excel template and they do not change.
  • neil.challinor I tried it on one program and it worked without an issue. Now I am trying it on another program and it tells me that there is already a file there and do I want to overwrite it (at the data path location). I go to the location and there is no file there, the folder is completely empty. I can't figure out where it is trying to save the file at. Below is the code I altered from the script and program. Do you see any issues with it? 

    CS1 =SCRIPT/FILENAME= Q:\JOBS\!EXCEL DATA\EXCEL LOOP COLUMN.BAS
FUNCTION/Main,SHOW=YES,ARG1=WO,ARG2=Y,ARG3="Q:\JOBS\CORELIN K\PT242-XXXX\PT242-0026\EXCEL SCRIPT REPORT\",,
STARTSCRIPT/


    Sub Main (strVariable As String, reasonVar As String, DataPath As String)


'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim fs As Object
Dim ReportDim As String
Dim CheckDim As String


'Check To see If results file exists
FilePath = "Q:\JOBS\!Excel Data\" '.xlsm And .bas files location
Set fs = CreateObject("Scripting.FileSystemObject")
ResFileExists = fs.fileexists(DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm") 'check program folder For .xlsm file
  • From what I can see it's taking the DataPath folder location and then building the filename from the PC-Dmis program part name (from the header at the top of the edit window) and adding whatever is passed in by your 1st & 2nd arguments so in the case above it would be saving to

    Q:\JOBS\CORELIN K\PT242-XXXX\PT242-0026\EXCEL SCRIPT REPORT\ program part name WO Y.xlsm

    Make sure your programs don't have the same part name in their headers (which they will if you have simply done a SaveAs and not edited it).
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement