hexagon logo

Help with 2 Scripts

Hi guys

I'm trying to get 2 scripts to work which I took from this forum and tried to adjust to our company needs as well as unify the code (using the same commands & variables)
I don't know how to script I just tried to understand from the description in the threads and in the scripts.

The first one is the folder create script:
https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/8758-create-folder-script
Sub main()


'************************************************* ************************************************** **********************
' Basierend auf dem "Create folder" Script von vpt.se und chadjac
' Based On the "Create folder" script from vpt.se und chadjac
' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/8758-create-folder-script
'************************************************* ************************************************** **********************


'-------------------------------------------------------------------------------------------------------------------------
' Erstellt die Objekte
' Create the objects
'-------------------------------------------------------------------------------------------------------------------------
Dim pcdapp As Object
Set pcdapp = createobject("pcdlrn.application")

Dim pcdpartprogram As Object
Set pcdpartprogram = pcdapp.activepartprogram

Dim fso As Object
Set fso = createobject("scripting.filesystemobject")


'-------------------------------------------------------------------------------------------------------------------------
' Findet die PC-DMIS Variable für den Protokoll Speicherpfad
' Gets the PC-DMIS variable For the protocol path
'-------------------------------------------------------------------------------------------------------------------------
Dim pathname As Object
Set pathname=pcdpartprogram.getvariablevalue("V_PROTOK OLL_PFAD")

strpath=pathname.stringvalue


'-------------------------------------------------------------------------------------------------------------------------
' Prüft ob der Protokoll Speicherpfad existiert & erstellt ihn wenn nicht
' Checks If the protocol path exists And creates it If Not
'-------------------------------------------------------------------------------------------------------------------------
Dim fsofolder As Object

If Not fso.folderexists(strpath) Then
Set fsofolder = fso.createfolder(strpath)
End If



'-------------------------------------------------------------------------------------------------------------------------
' Räumt auf
' Tidies up
'-------------------------------------------------------------------------------------------------------------------------
Set fso = Nothing
Set pcdpartprogram = Nothing
Set pcdapp = Nothing


End Sub


and the second is the AutoArchive script:
https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/390021-auto-archive-freebie
Sub main()


'************************************************* ************************************************** **********************
' Basierend auf dem "AUTOARCHIVE.BAS" Script von NinjaBadger (JON WOOD)
' Based On the "AUTOARCHIVE.BAS" script from NinjaBadger (JON WOOD)
' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/390021-auto-archive-freebie
'************************************************* ************************************************** **********************


'-------------------------------------------------------------------------------------------------------------------------
' Erstellt die Objekte
' Create the objects
'-------------------------------------------------------------------------------------------------------------------------
Dim pcdapp As Object
Set pcdapp = createobject("pcdlrn.application")

Dim pcdpartprogram As Object
Set pcdpartprogram = pcdapp.activepartprogram

Dim fso As Object
Set fso = createobject("scripting.filesystemobject")


'-------------------------------------------------------------------------------------------------------------------------
' Speichert das originale Messprogramm
' Saves the original part program
'-------------------------------------------------------------------------------------------------------------------------
pcdpartprogram.save


'-------------------------------------------------------------------------------------------------------------------------
' Findet den vollen Namen des originalen Messprogramms (mit Pfad & Dateiendung)
' Gets the full Name of the original part program (With path & file extension)
'-------------------------------------------------------------------------------------------------------------------------
Dim source_path
source_path = pcdpartprogram.fullname


'-------------------------------------------------------------------------------------------------------------------------
' Findet die PC-DMIS Variablen für den Archiv Speicherpfad und Dateinamen
' Gets the PC-DMIS variables For the archive path And file Name
'-------------------------------------------------------------------------------------------------------------------------
Dim pathname As Object
Set pathname=pcdpartprogram.getvariablevalue("V_ARCHIV _PFAD")

strpath=pathname.stringvalue


Dim partname As Object
Set partname=pcdpartprogram.getvariablevalue("V_ARCHIV _NAME")

strpart=partname.stringvalue


'-------------------------------------------------------------------------------------------------------------------------
' Prüft ob der Archiv Speicherpfad existiert & erstellt ihn wenn nicht
' Checks If the archive path exists And creates it If Not
'-------------------------------------------------------------------------------------------------------------------------
Dim fsofolder As Object

If Not fso.folderexists(strpath) Then
Set fsofolder = fso.createfolder(strpath)
End If


'-------------------------------------------------------------------------------------------------------------------------
' Generiert den vollen Archiv Namen (mit Pfad & Dateiendung)
' Generates the full archive Name (With path & file extension)
'-------------------------------------------------------------------------------------------------------------------------
dest_path = strpath & "\" & strpart & "_" & format(now(),"YYYYMMDDHHNNSS") & ".prg"
'MsgBox(dest_path)


'-------------------------------------------------------------------------------------------------------------------------
' Kopiert die Originaldatei In das Archiv
' Copies the original file To the archive
'-------------------------------------------------------------------------------------------------------------------------
fso.copyfile source_path, dest_path


'-------------------------------------------------------------------------------------------------------------------------
' Räumt auf
' Tidies up
'-------------------------------------------------------------------------------------------------------------------------
Set fso = Nothing
Set pcdpartprogram = Nothing
Set pcdapp = Nothing


End Sub


This is the Code in PC-DMIS:
 ​​​​​​​


On both the scripts I get the error (OLE Automation method exception) on the same command: Set fsofolder = fso.createfolder(strpath)

Do you guys see the error I made?

Thanks in advance for your help.

Attached Files
Parents
  • It's me again

    I encountered 2 new problems in the second script (the auto-archive one from NinjaBadger)

    1) I noticed that the original script doesn't save the corresponding CAD files. So I tried to add this function using this help:
    https://docs.hexagonmi.com/pcdmis/2021.1/en/helpcenter/mergedProjects/automationobjects/PCDLRN~CadModel~CADModelFile.html

    I now get an error on line 45: Unknown name: CadModelName

    I tried it with 2 routines, one with and one without CAD and get the same error.
    But I guess once I eliminate the error on line 45 I need to adjust the code on line 130 and 139 depending I have a CAD or not?


    2) I changed how I create the archive file name (before in PC-DMIS now in the script)
    In PC-DMIS I used the following code to format a number with leading zeros:
    FORMAT("%04d",INT(V_TEIL))

    So if I enter part number 1 it would change it to 0001 or 99 to 0099.
    I would like to do this operation in the script now to reduce the "clutter" in the routine.
    How can I change the lines 74 to 77 to achieve this?



    Sub main()
    
    
    '************************************************* ************************************************** **********************
    ' Basierend auf dem "AUTOARCHIVE.BAS" Script von NinjaBadger (JON WOOD)
    ' Based On the "AUTOARCHIVE.BAS" script from NinjaBadger (JON WOOD)
    ' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/390021-auto-archive-freebie
    '************************************************* ************************************************** **********************
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Erstellt die Objekte
    ' Create the objects
    '-------------------------------------------------------------------------------------------------------------------------
    Dim pcdapp As Object
    Set pcdapp = createobject("pcdlrn.application")
    
    Dim pcdpartprogram As Object
    Set pcdpartprogram = pcdapp.activepartprogram
    
    Dim fso As Object
    Set fso = createobject("scripting.filesystemobject")
    
    Dim CAD AS Object
    Set CAD = pcdpartprogram.CadModel
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Speichert das originale Messprogramm
    ' Saves the original part program
    '-------------------------------------------------------------------------------------------------------------------------
    pcdpartprogram.save
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet den vollen Namen des originalen Messprogramms (mit Pfad & Dateiendung)
    ' Gets the full Name of the original part program (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    Dim source_path_prg
    source_path_prg = pcdpartprogram.fullname
    'MsgBox(source_path_prg)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet den vollen Namen des originalen CADs (mit Pfad & Dateiendung)
    ' Gets the full Name of the original CAD (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    Dim source_path_cad
    source_path_cad = CAD.CADModelName '????????????????????????????????????????????????? ???????????????????????????????????
    MsgBox(source_path_cad)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Definiert das Hauptverzeichniss für den Archiv Speicherpfad
    ' Defines the root folder for the archive path
    '-------------------------------------------------------------------------------------------------------------------------
    strpath = "W:\TEST\90_Archiv\MessprogrammAutoArchiv\"
    'MsgBox(strpath)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet die PC-DMIS Variablen für den Archiv Speicherpfad und Dateinamen
    ' Gets the PC-DMIS variables for the archive path and file name
    '-------------------------------------------------------------------------------------------------------------------------
    Dim artikel As Object
    Set artikel = pcdpartprogram.getvariablevalue("V_ARTIKEL")
    strartikel = artikel.stringvalue
    'MsgBox(strartikel)
    
    Dim pa As Object
    Set pa = pcdpartprogram.getvariablevalue("V_PA")
    strpa = pa.stringvalue
    'MsgBox(strpa)
    
    Dim operation As Object
    Set operation = pcdpartprogram.getvariablevalue("V_OPERATIONSSCHRI TT")
    stroperation = operation.stringvalue
    'MsgBox(stroperation)
    
    Dim teil As Object
    Set teil = pcdpartprogram.getvariablevalue("V_TEIL")
    strteil = teil.stringvalue
    MsgBox(strteil)
    
    Dim toleranz As Object
    Set toleranz = pcdpartprogram.getvariablevalue("V_OOT")
    strtoleranz = toleranz.stringvalue
    'MsgBox(stroperation)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Prüft ob der Archiv Speicherpfad existiert & erstellt ihn wenn nicht
    ' Checks If the archive path exists and creates it if not
    '-------------------------------------------------------------------------------------------------------------------------
    Dim fsofolder As Object
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & strartikel
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & strpa
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & stroperation
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Generiert das aktuelle Datum & Uhrzeit
    ' Generates the current date & time
    '-------------------------------------------------------------------------------------------------------------------------
    'Dim datetime As Object
    datetime = format(now(),"YYYYMMDDHHNNSS")
    'MsgBox(datetime)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Generiert den vollen Archiv Namen für das Messprogramm & CAD (mit Pfad & Dateiendung)
    ' Generates the full archive name for the part program & CAD (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    dest_path_prg = strpath & "\" & strartikel & "_" & strpa & "_" & stroperation & "_T" & strteil & "_" & strtoleranz & "_" & datetime & ".prg"
    'MsgBox(dest_path_prg)
    
    dest_path_cad = strpath & "\" & strartikel & "_" & strpa & "_" & stroperation & "_T" & strteil & "_" & strtoleranz & "_" & datetime & ".cad"
    'MsgBox(dest_path_cad)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Kopiert das original Messprogramm & CAD in das Archiv
    ' Copies the original part program & CAD to the archive
    '-------------------------------------------------------------------------------------------------------------------------
    fso.copyfile source_path_prg, dest_path_prg
    
    fso.copyfile source_path_cad, dest_path_cad
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Räumt auf
    ' Tidies up
    '-------------------------------------------------------------------------------------------------------------------------
    Set fso = Nothing
    Set pcdpartprogram = Nothing
    Set pcdapp = Nothing
    
    
    End Sub


    Attached Files
Reply
  • It's me again

    I encountered 2 new problems in the second script (the auto-archive one from NinjaBadger)

    1) I noticed that the original script doesn't save the corresponding CAD files. So I tried to add this function using this help:
    https://docs.hexagonmi.com/pcdmis/2021.1/en/helpcenter/mergedProjects/automationobjects/PCDLRN~CadModel~CADModelFile.html

    I now get an error on line 45: Unknown name: CadModelName

    I tried it with 2 routines, one with and one without CAD and get the same error.
    But I guess once I eliminate the error on line 45 I need to adjust the code on line 130 and 139 depending I have a CAD or not?


    2) I changed how I create the archive file name (before in PC-DMIS now in the script)
    In PC-DMIS I used the following code to format a number with leading zeros:
    FORMAT("%04d",INT(V_TEIL))

    So if I enter part number 1 it would change it to 0001 or 99 to 0099.
    I would like to do this operation in the script now to reduce the "clutter" in the routine.
    How can I change the lines 74 to 77 to achieve this?



    Sub main()
    
    
    '************************************************* ************************************************** **********************
    ' Basierend auf dem "AUTOARCHIVE.BAS" Script von NinjaBadger (JON WOOD)
    ' Based On the "AUTOARCHIVE.BAS" script from NinjaBadger (JON WOOD)
    ' https://www.pcdmisforum.com/forum/pc-dmis-enterprise-metrology-software/pc-dmis-code-samples/390021-auto-archive-freebie
    '************************************************* ************************************************** **********************
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Erstellt die Objekte
    ' Create the objects
    '-------------------------------------------------------------------------------------------------------------------------
    Dim pcdapp As Object
    Set pcdapp = createobject("pcdlrn.application")
    
    Dim pcdpartprogram As Object
    Set pcdpartprogram = pcdapp.activepartprogram
    
    Dim fso As Object
    Set fso = createobject("scripting.filesystemobject")
    
    Dim CAD AS Object
    Set CAD = pcdpartprogram.CadModel
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Speichert das originale Messprogramm
    ' Saves the original part program
    '-------------------------------------------------------------------------------------------------------------------------
    pcdpartprogram.save
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet den vollen Namen des originalen Messprogramms (mit Pfad & Dateiendung)
    ' Gets the full Name of the original part program (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    Dim source_path_prg
    source_path_prg = pcdpartprogram.fullname
    'MsgBox(source_path_prg)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet den vollen Namen des originalen CADs (mit Pfad & Dateiendung)
    ' Gets the full Name of the original CAD (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    Dim source_path_cad
    source_path_cad = CAD.CADModelName '????????????????????????????????????????????????? ???????????????????????????????????
    MsgBox(source_path_cad)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Definiert das Hauptverzeichniss für den Archiv Speicherpfad
    ' Defines the root folder for the archive path
    '-------------------------------------------------------------------------------------------------------------------------
    strpath = "W:\TEST\90_Archiv\MessprogrammAutoArchiv\"
    'MsgBox(strpath)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet die PC-DMIS Variablen für den Archiv Speicherpfad und Dateinamen
    ' Gets the PC-DMIS variables for the archive path and file name
    '-------------------------------------------------------------------------------------------------------------------------
    Dim artikel As Object
    Set artikel = pcdpartprogram.getvariablevalue("V_ARTIKEL")
    strartikel = artikel.stringvalue
    'MsgBox(strartikel)
    
    Dim pa As Object
    Set pa = pcdpartprogram.getvariablevalue("V_PA")
    strpa = pa.stringvalue
    'MsgBox(strpa)
    
    Dim operation As Object
    Set operation = pcdpartprogram.getvariablevalue("V_OPERATIONSSCHRI TT")
    stroperation = operation.stringvalue
    'MsgBox(stroperation)
    
    Dim teil As Object
    Set teil = pcdpartprogram.getvariablevalue("V_TEIL")
    strteil = teil.stringvalue
    MsgBox(strteil)
    
    Dim toleranz As Object
    Set toleranz = pcdpartprogram.getvariablevalue("V_OOT")
    strtoleranz = toleranz.stringvalue
    'MsgBox(stroperation)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Prüft ob der Archiv Speicherpfad existiert & erstellt ihn wenn nicht
    ' Checks If the archive path exists and creates it if not
    '-------------------------------------------------------------------------------------------------------------------------
    Dim fsofolder As Object
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & strartikel
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & strpa
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    strpath = strpath & "\" & stroperation
    'MsgBox(strpath)
    
    If Not fso.folderexists(strpath) Then
    Set fsofolder = fso.createfolder(strpath)
    End If
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Generiert das aktuelle Datum & Uhrzeit
    ' Generates the current date & time
    '-------------------------------------------------------------------------------------------------------------------------
    'Dim datetime As Object
    datetime = format(now(),"YYYYMMDDHHNNSS")
    'MsgBox(datetime)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Generiert den vollen Archiv Namen für das Messprogramm & CAD (mit Pfad & Dateiendung)
    ' Generates the full archive name for the part program & CAD (with path & file extension)
    '-------------------------------------------------------------------------------------------------------------------------
    dest_path_prg = strpath & "\" & strartikel & "_" & strpa & "_" & stroperation & "_T" & strteil & "_" & strtoleranz & "_" & datetime & ".prg"
    'MsgBox(dest_path_prg)
    
    dest_path_cad = strpath & "\" & strartikel & "_" & strpa & "_" & stroperation & "_T" & strteil & "_" & strtoleranz & "_" & datetime & ".cad"
    'MsgBox(dest_path_cad)
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Kopiert das original Messprogramm & CAD in das Archiv
    ' Copies the original part program & CAD to the archive
    '-------------------------------------------------------------------------------------------------------------------------
    fso.copyfile source_path_prg, dest_path_prg
    
    fso.copyfile source_path_cad, dest_path_cad
    
    '-------------------------------------------------------------------------------------------------------------------------
    ' Räumt auf
    ' Tidies up
    '-------------------------------------------------------------------------------------------------------------------------
    Set fso = Nothing
    Set pcdpartprogram = Nothing
    Set pcdapp = Nothing
    
    
    End Sub


    Attached Files
Children
No Data