hexagon logo
Register Sign in
  • Replies 17 replies
  • Subscribers 32 subscribers
  • Views 283 views
  • Users 0 members are here
Options
Related

Need a little guidance

Rploughe
Has anyone come across a way to export a program run as basic?
Or, has come across a way to export a program run in a way that can be imported back in later for review?

I know it may seem unnecessary.

My lab does a lot of protoyping, and as a result the customer sometimes desires to change datum scheme/bonus/hit targets/profile tolerances as the process goes on.
It gets tedious to have to re-run a part to get updated dimensional data.

Is there a solid way to do it?
I've exported programs as basic before, then re-uploaded them.
So i would assume it is possible.

I would just prefer an automated approach, anyone point me in a direction?
  • This saves the entire .prg file.


    NOTE! It does this by first saving the program which is executing, then copying the file to an archive location.

    i.e. if you can't save the existing program with measured data in it for some reason you'll need to find another method. 




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

Sub main()


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

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

'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 works 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
MsgBox(source_path & chr(13) & dest_path)

fso.copyfile source_path, dest_path


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


End Sub


    Call it from within Pc-Dmis like so... 


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

  • Neat little script.
    I will probably modify it to include a CAD file if present and append both files to their own folder.
    Is there a way through the basic script shell, to append to a zip archive?
    Save space.
  • this script is what i was searching for exept of one item i do miss. the Serial Number in the file name.
    I tried to add this but i really have no clue how to.
    i added this 
    Dim serial
serial =Serial_number

    and changed the file name to: 
    dest_path = archivePath & "\" & progname & "\" & progname & "_" & [COLOR=#FF0000]Seria[/COLOR]l & "_" & uid & "_" & Format(Now(), "YYYYMMDDHHNN") & ".prg"


    somehow the callout is "193" and not what i've filled in as Serial Number.
    What have i done wrong?

    At the beginning of each prg the serial number is defined 
    WERKSTÜCKSNAME : 45555
VERSIONSNR.: 5208438/-
SERIENNR.: [COLOR=#FF0000]88066_000[/COLOR]


    need help
  • in reply to Craess
    If you replace 'serial' with 'Serial_number', does it say the same thing? Are you sure you are using the correct source variable (Serial_number)?
  • in reply to Craess
    I replaced it in the dest_path --> same result 193
    no i'm not sure this is the correct source variable. in my fileheader i work with =SERIAL_NUMBER and i get what i filled in so i thought it will be the same.
  • i'm not sure this is the correct source variable. in my fileheader i work with =SERIAL_NUMBER and i get what i filled in so i thought it will be the same.




    There's no correlation between "Report BASIC" and "Script BASIC". If you need the SER NUMBER from the program you need something like this (off the top of my head, untested, code): 

    Dim App As Object
Dim Part As Object
Sub main
  Set App = CreateObject("PCDLRN.Application")
  Set Part = App.ActivePartProgram
  Serial = Part.SerialNumber
End Sub

  • in reply to AndersI
    Thank you so much. it worked.
    the script looks like this: 
    'Add Serial Number To Path
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Serial = Part.SerialNumber

'Genrate the destination (save) path
dest_path = archivePath & "\" & progname & "\" & progname & "_" & Serial & "_" & uid & "_" & Format(Now(), "YYYYMMDDHHNN") & ".prg"
'MsgBox(dest_path)


    Thank you, again
  • I have recently made the biggest mistake - update from 2019R1 to R2
    The problem I have now is not working script created by Everything was perfect up to 2019R1, on 2019R2 throws the error like in the below picture.

    Attached Files
  • I'll get back to this later but as a quick thought try replace every instance of 'uid' with something like 'uniqueid'
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement