Auto Archive Freebie!

Hi All,

Here's my script for archiving programs.

Copy it to notepad and save it as AUTOARCHIVE.BAS

NOTE / WARNING -- This script first saves the program with the current measurement data in it, then takes a copy of the file to archive.

'JON WOOD - 2013 - AUTOMETTECH LTD (UK) www.automettech.com

Sub main()


'========= SETTINGS =================

'Root save directory For archive
Dim archivePath
archivePath = "C:\CMM\Archive\AutoArchive"

'This is the Name of a PC-Dmis ASSIGNMENT - If it exist the value it holds will be used In the file Name
'of the archived program (i.e. can be a serial number, Or order number etc)

Dim myUID
myUID = "UID"

'NOTE! - File Name will be In the following format...
'SaveDirectory\Program Name\ProgramName_UniqueID_DateTime.prg

'i.e. C:\CMM Files\Part Program Run Instances Archive\123456-01\123456-01_abc123_20140824104232.prg

'Where...
'archivePath = "C:\CMM Files\Part Program Run Instances Archive"
'Part program = 123456-01.prg
'Serial Number / Unique Id = abc123
'DateTime = 24/08/2014 10:42:32


'===========End OF SETTINGS==========

'Create objects
Dim pcapp As Object
Set pcapp = createobject("pcdlrn.application")

Dim pcpart As Object
Set pcpart = pcapp.activepartprogram

'Save existing program
pcpart.save

'Get the current program path
Dim source_path
source_path = pcpart.fullname

'Get program Name (without file extension)
Dim progname
progname = left(pcpart.Name,len(pcpart.Name)-4)

'Create File System Object For file operations
Dim fso As Object
Set fso = createobject("scripting.filesystemobject")

'Check main archive directory And program specific directories exist
Dim ofolder As Object

If Not fso.folderexists(archivepath) Then
Set ofolder = fso.createfolder(archivepath)
End If

If Not fso.folderexists(archivepath & "\" & progname) Then
Set ofolder = fso.createfolder(archivepath & "\" & progname)
End If

'Get a UID If present
Dim uniqueid
uniqueid=""

Dim myvar As Object
Set myvar = pcpart.getvariablevalue(myUID)

If Not myVar is Nothing Then
uniqueid= myvar.stringvalue
'MsgBox(uniqueid)
End If

'Genrate the destination (save) path
dest_path = archivepath & "\" & progname & "\" & progname & "_" & uniqueid & "_" & format(now(),"YYYYMMDDHHNNSS") & ".prg"
'MsgBox(dest_path)


'Save the file
fso.copyfile source_path, dest_path


'Tidy up
Set fso = Nothing
Set pcpart = Nothing
Set pcapp = Nothing


End Sub

[CODE]


Usage in part program...

[CODE]


ASSIGN/UID="abc123"


CS5        =SCRIPT/FILENAME= C:\CMM FILES\SUBROUTINES\AUTOARCHIVE.BAS
            FUNCTION/Main,SHOW=YES,,
            STARTSCRIPT/
            ENDSCRIPT/

Parents

CodeWarrior over 5 years ago

I think I'm getting closer to getting it to work. Its taking a little bit for me to test and everything in between part cycles so i may have to wait till the weekend..

I'll update this with what I changed to get it to work.

UPDATE:

I couldn't find a way to make it work using subroutines.

The solution I came up with was to launch, execute, close multiple programs from a script in excel or visual studio while using your script inside the individual part programs.
Here's the link for the script I modified:

https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/32023-automated-execution-of-several-consecutive-programs

Below is the finished code:

Sub ExcelMultiRun()


Dim PCDApp, PCDPartProgram, PCDProgramCommand


''

Set PCDApp = CreateObject("PCDLRN.Application")

    PCDApp.Visible = True

Set PCDPartProgram = PCDApp.PartPrograms


'''Program #1

    PCDPartProgram.Open "C:\CMM Programs\_CMM Programs\Operator Programs\53015-10FPC1.PRG", "CMM1"

Set PCDProgramCommand = PCDApp.ActivePartProgram


    PCDProgramCommand.Execute 'Executes part program..



    PCDProgramCommand.Close   'Closes Program (and saves)


'''Program #2

    PCDPartProgram.Open "C:\CMM Programs\_CMM Programs\Operator Programs\53015-10AUDC1.PRG", "CMM1"

Set PCDProgramCommand = PCDApp.ActivePartProgram


    PCDProgramCommand.Execute 'Executes part program..



    PCDProgramCommand.Close   'Closes Program (and saves)


' Cleanup
Set PCDProgramCommand = Nothing
Set PCDPartProgram = Nothing
Set PCDApp = Nothing


End Sub

Reply

CodeWarrior over 5 years ago

Sub ExcelMultiRun()


Dim PCDApp, PCDPartProgram, PCDProgramCommand


''

Set PCDApp = CreateObject("PCDLRN.Application")

    PCDApp.Visible = True

Set PCDPartProgram = PCDApp.PartPrograms


'''Program #1

    PCDPartProgram.Open "C:\CMM Programs\_CMM Programs\Operator Programs\53015-10FPC1.PRG", "CMM1"

Set PCDProgramCommand = PCDApp.ActivePartProgram


    PCDProgramCommand.Execute 'Executes part program..



    PCDProgramCommand.Close   'Closes Program (and saves)


'''Program #2

    PCDPartProgram.Open "C:\CMM Programs\_CMM Programs\Operator Programs\53015-10AUDC1.PRG", "CMM1"

Set PCDProgramCommand = PCDApp.ActivePartProgram


    PCDProgramCommand.Execute 'Executes part program..



    PCDProgramCommand.Close   'Closes Program (and saves)


' Cleanup
Set PCDProgramCommand = Nothing
Set PCDPartProgram = Nothing
Set PCDApp = Nothing


End Sub

Children

CodeWarrior over 5 years ago in reply to CodeWarrior

Also thanks again. Your script examples with the explanation comments are very helpful to understanding this stuff
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel