Auto Archive Freebie!

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

  • 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 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

    [CODE]


    Usage in part program...

    Code:
    ASSIGN/UID="abc123"
    
    
    CS5        =SCRIPT/FILENAME= C:\CMM FILES\SUBROUTINES\AUTOARCHIVE.BAS
                FUNCTION/Main,SHOW=YES,,
                STARTSCRIPT/
                ENDSCRIPT/
    Automettech - Automated Metrology Technology

  • #2
    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

    Comment


    • #3
      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)

      Automettech - Automated Metrology Technology

      Comment


      • #4
        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, 01:01 PM. Reason: Updated older post with solution

        Comment


        • CodeWarrior
          CodeWarrior commented
          Editing a comment
          Also thanks again. Your script examples with the explanation comments are very helpful to understanding this stuff

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

        Comment


        • #6
          My pleasure!
          Automettech - Automated Metrology Technology

          Comment


          • #7
            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.
            "Do what I want you to do, not what I tell you to do."

            -Me

            Comment


            • #8
              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, 10:31 AM.
              AndersI
              SW support - Hexagon Metrology Nordic AB

              Comment

            Related Topics

            Collapse

            Working...
            X