hexagon logo
Register Sign in
  • Replies 24 replies
  • Subscribers 30 subscribers
  • Views 562 views
  • Users 0 members are here
Options
Related

Help with 2 Scripts

Aaron Baldauf
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
  • ah now i get it,

    "fso.createfolder(strpath)" failed if you try to create multible folders at once.
    It can only create the last folder in the path and only if the rest of the path exists

    Slight smile

    if this is the problem, you will need something like this: 

    Sub pcDMIS_ForceDirectories(ByVal sPath As String)
  Dim vPath, sPuffer As String
  vPath = Trim(sPath)

  If Right(vPath, 1) = "\" Then
    vPath = Mid(vPath, 1, Len(vPath) - 1)
  End If

  Dim N1 As Integer
  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  Dim fsofolder As Object

  N1 = InStr(4, vPath, "\")
  If (N1 <> 0) and (Not fso.folderexists(vPath)) Then
    sPuffer = Mid(vPath, 1, N1 - 1)
    Do While N1 <> 0
      If Not fso.folderexists(sPuffer) Then
        Set fsofolder = fso.createfolder(sPuffer)
      End If

      N1 = InStr(N1 + 1, vPath, "\")
      If N1 <> 0 Then sPuffer = Mid(vPath, 1, N1 - 1)
    Loop
  end if


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

  Set fso = Nothing
End Sub



    grüße

  • Thanks for the input!
    I had some time today to test different things with our IT and they came to the same conclusion.

    I already tried to adjust the script so it looks a bit different than yours:

    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...-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")

    '-------------------------------------------------------------------------------------------------------------------------
    ' Definiert das Hauptverzeichniss für den Protokoll Speicherpfad
    ' Defines the root folder For the protocol path
    '-------------------------------------------------------------------------------------------------------------------------
    strpath = "W:\TEST\10_Messprotokolle"
    MsgBox(strpath)

    '-------------------------------------------------------------------------------------------------------------------------
    ' Findet die PC-DMIS Variablen für den Protokoll Speicherpfad
    ' Gets the PC-DMIS variables For the protocol path
    '-------------------------------------------------------------------------------------------------------------------------
    Dim strartikel As Object
    Set strartikel = pcdpartprogram.getvariablevalue("V_ARTIKEL")
    MsgBox(strartikel)

    Dim strpa As Object
    Set strpa = pcdpartprogram.getvariablevalue("V_PA")
    MsgBox(strpa)

    Dim stroperation As Object
    Set stroperation = pcdpartprogram.getvariablevalue("V_OPERATIONSSCHRI TT")
    MsgBox(stroperation)

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

    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

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


    End Sub

    Now I'm running into the next problem...Disappointed

    Somehow the script can't get the variables from PC-DMIS.
    I get an error message with every MsgBox after the different variables.

    The error message is:
    Error on line: 36 - OLE Automation object does not have a default value
    Attached Files
  • Have you tried to execute the routine again?
  • davehocum
    yes i execute the routine always from the beginning.
    it doesn't measure anything yet its just my inputs and then the scripts.
  • I just briefly look at this post.
    Have you tried to use the String Value?

    Dim strartikel As Object
    Set strartikel = pcdpartprogram.getvariablevalue("V_ARTIKEL")
    C1 = strartikel.StringValue
    MsgBox C1
  • davehocum
    IT WORDED!

    I totally missed that step Blush

    Thanks to all who helped me!

    Will now adjust the 2nd script and let you guys know

  • 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
  • hi there,

    1:
    use "SaveAs" it will also save the CAD file
    (maybe cant be used while exceuted) 
    Sub Main ()
  Dim App As Object
  Set App = CreateObject("PCDLRN.Application")
  Dim Part As Object
  Set Part = App.ActivePartProgram
  Part.SaveAs "d:\temp\testprogram.prg"
End Sub




    2:
    CAD files has always the same name: 
    ............

'-------------------------------------------------------------------------------------------------------------------------
' 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 = Left(source_path_prg,Len(source_path_prg)-4) & ".CAD"
MsgBox(source_path_cad)

.........
  • Thanks to all for your help. I now got the two scripts to work Slight smile

    Attached you will find the two final scripts.

    I will not post them as a code as it exceeds the character limit and also because the forum ads some spaces that are not in my original code Upside down
  • in reply to Aaron Baldauf
    " Format(strteil%, "0000") " will only works with numbers and it will give you a error if the number is larger than 9999
    Slight smile
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement