Auto Archive Freebie!

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • NinjaBadger
    replied
    I've updated the OP to deal with the change in 2019 onwards where protected keywords can't be used in scripts.

    Leave a comment:


  • A-machine-insp
    commented on 's reply
    AndersI Works perfectly!!! Thanks!

  • AndersI
    replied
    That's whats done first in the script

    Code:
    '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 uid
    uid=""
    
    Dim myvar As Object
    Set myvar = pcpart.getvariablevalue(myUID)
    
    If Not myVar is Nothing Then
    uid = myvar.stringvalue
    'MsgBox(uid)
    End If
    
    'Genrate the destination (save) path
    dest_path = archivepath & "\" & progname & "\" & progname & "_" & uid & "_" & 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
    Last edited by AndersI; 09-27-2019, 09:31 AM.

    Leave a comment:


  • A-machine-insp
    replied
    Question on this. Is there a way to get DMIS to save the program when it is done executing without a special nomenclature. I want it to basically do a "CRTL + S" when the execution is finished.

    Here is the problem. We have been running lights out and every now and then we come in the next morning and the computer has restarted with out the program being saved. Last night, we lost 5 hours of CMM run time due to this. All of our programs are on our network then transferred to the local C drive and ran from there so a simple save when the program is done (overwrite itself on the C drive) is ok because we always have the master program on the network.

    Leave a comment:


  • NinjaBadger
    replied
    My pleasure!

    Leave a comment:


  • LostL
    replied
    Nice! I've been tasked to make something like this, this will certainly shorten the work.

    Leave a comment:


  • CodeWarrior
    commented on 's reply
    Also thanks again. Your script examples with the explanation comments are very helpful to understanding this stuff

  • CodeWarrior
    replied
    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...utive-programs

    Below is the finished code:
    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
    Last edited by CodeWarrior; 09-27-2019, 12:01 PM. Reason: Updated older post with solution

    Leave a comment:


  • NinjaBadger
    replied
    Hmmm, I'm not sure how you'd do that - I tend not to use subroutines (apart from program start / header and footer / printing etc)

    Leave a comment:


  • CodeWarrior
    replied
    Thank you for posting this. I already have been using this to save programs when I'm running large amounts of parts so I can go back and modify the alignments/reporting etc.
    I changed the UID variable to run_count to suit my purposes.

    One thing I'm struggling with is I will sometimes run programs with multiple subroutines and I want to save the individual subroutines. I put the script at the end of the subroutine, but I know that in your example its calling the active program.

    "Dim pcpart As Object
    Set pcpart = pcapp.activepartprogram"

    I've looked around the object browser and found the command Application.SetActive and was thinking this may be the command i'm looking for. I'm not sure on the correct syntax to "activate" another program though and was hoping you may be able to point me in the right direction.

    Thanks in advance

    Leave a comment:


  • NinjaBadger
    started a topic Auto Archive Freebie!

    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.


    [CODE]
    '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/
    Last edited by NinjaBadger; 05-29-2020, 05:49 AM.

Related Topics

Collapse

Working...
X