Saving PCDMIS file at end of program

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

  • Saving PCDMIS file at end of program

    Can anyone give me a code example for saving the entire PCDMIS file and CAD file in a certain location at the end of the program?

    Thanks.

  • #2
    This method uses several arguments passed over from PC-DMIS to concatenate the path and file name and then saves the program as that path/file name. So this is a push method where the data is pushed over to the script when the script is called. You can also use a pull method were you use the ".GetVariableValue" method to pull the value from a specific variable in the PC-DMIS program. An example of this type of code follows after the main script.


    Code:
    Sub Main (PN As String, OP As String, SN As String, RPTTIME As String, RPTDATE As String, PRG As String, PRG_TYPE As String)
    
    Dim App As Object
    Dim Part As Object
    Dim Cmds As Object
    Dim Cmd As Object
    
    ' Initialize PC-DMIS
    Set App = CreateObject("PCDLRN.Application")
        If App Is Nothing Then
            MsgBox "PC-DMIS initialization error!",48, "Error!"
            Exit Sub
        Else
            Set Part = App.ActivePartProgram
            If Part Is Nothing Then
                MsgBox "Part Program not opened!", 48, "Error!"
                Exit Sub
            Else
                Set Cmds = Part.Commands
                If Cmds Is Nothing Then
                    MsgBox "Pointer to commands not valid!", 48, "Error!"
                    Exit Sub
                End If
            End If
        End If
    
    
    Dim CrntName As String
    Dim NewName As String
    
    CrntName = Part.FullName
    'MsgBox(CrntName)
    
    Newname = PRG & PN & "\RESULTS\" & OP & "\" & PN & "_" & OP & "_" & PRG_TYPE & "_" & SN & "_" & RPTDATE & "_" & RPTTIME & ".PRG"
    'MsgBox(Newname)
    
    Dim Retval As Boolean
    retval = Part.SaveAs(newname)  
    
    
    ' Cleanup
    Set Cmd = Nothing
    Set Cmds = Nothing
    Set Part = Nothing
    Set App = Nothing
    End Sub

    Code:
    Set Part_Num = Part.GetVariableValue ("PN")
    PN = Part_Num.doublevalue
    2013MR1 SP6
    Global Frames, Tesastar-M Heads, LSP-X1M/H Probes

    Comment


    • #3
      Here's a variation that automatically adds a number at the end of the file name (and increments it each call).
      (It would be a good idea to enhance this with the safeguards in DaSalo's program)

      Code:
      ' Add 1 to the file name, until an unused name is reached
      Sub Increment(Filename As String, FilePath As String)
      
        Dim p As Integer
        Dim NewNumber As Integer
      
        Do
          p = InStr(1, UCase(FileName), ".PRG")
          If (p > 0) Then
            FileName = left(FileName, p-1)
          End If
      
          p = Len(FileName)
          While (p > 0) And (Instr(1, "0123456789", Mid(FileName, p, 1)) > 0)
            p = p - 1
          Wend
      
          NewNumber = Val(Right(FileName, Len(FileName)-p))
      
          FileName = Left(FileName, p) + Str(NewNumber + 1)  + ".PRG"
      
        On Error Resume Next
        Loop Until (FileLen(FilePath + FileName) = 0)
        On Error GoTo 0
      
      End Sub
      
      ' Increment the file name and save
      ' NOTE: It's the prog with the new name that is open in
      ' PC-DMIS after this.
      
      Sub IncrSave(FilePath As String)
      
        Dim FileName As String
        Dim DmisApp As Object
        Dim DmisPart As Object
      
      ' Connect to PC-DMIS
        Set DmisApp = CreateObject("PCDLRN.Application")
        Set DmisPart = DmisApp.ActivePartProgram
      
        FileName = DmisPart.Name
      
      ' Make sure the path ends in "\"
        If Len(FilePath) > 0 Then
          If Mid(FilePath, Len(FilePath),1) <> "\" Then
            FilePath = FilePath + "\"
          End If
        End If
      
      ' Increment the name and save the program
        Increment FileName, FilePath
        DmisPart.SaveAs FilePath + FileName
      
      ' finish
        Set DmisPart = Nothing
        Set DmisApp = Nothing
      
      End Sub
      
      ' Just for testing
      Sub Main
        IncrSave("C:\TEMP")
      End Sub
      AndersI
      SW support - Hexagon Metrology Nordic AB

      Comment


      • #4
        Excellent, thank you both.

        Comment


        • #5
          Here is my version where it adds the date and the serialization entered and then restores the file name.

          Code:
          ' Displays an inputbox telling the user To enter a serial number
          ' Or other information that will be concatenated To the partprogram
          ' Name (partname) And saved In the current partprogram folder.
          '
          ' ORIGINAL CODE by vpt.se 2010
          '
          ' Modified by Doug To just concatenate the date And time
          ' And To take the serialization number from ASSIGN/SRN="xxx" in the program And Input it into this one
          '
          Sub Main()
          Dim PCDApp, PCDPartPrograms, PCDPartProgram
          Set PCDApp = CreateObject("PCDLRN.Application")
          Set PCDPartPrograms = PCDApp.PartPrograms
          Set PCDPartProgram = PCDApp.ActivePartProgram
          
          Dim setCrntName As String 
          Set Serial = PCDPartProgram.GetVariableValue ("SRN")
          Dim SerialNo As String
          
          SerialNo = Serial.StringValue
          
          
          ' my added code
          HR = HOUR(NOW)
          MN = MINUTE(NOW)
          SEC = SECOND(NOW)
          MON = MONTH(NOW)
          DY = DAY(NOW)
          YR = YEAR(NOW)
          'my added code
          
          'added Mar 13, 2014 testing creating directory Name from date.
          
          Select Case MON
              Case "1"
                 MonthName="JAN"
              Case "2"
                 MonthName ="FEB"
              Case "3"
                 MonthName="MAR"
              Case "4"
                 MonthName="APR"
              Case "5"
                MonthName="MAY"
              Case "6"
                MonthName="JUN"
              Case "7"
                MonthName="JUL"
              Case "8"
                MonthName="AUG"
              Case "9"
                MonthName="SEP"
              Case "10"
                MonthName="OCT"
              Case "11"
                MonthName="NOV"
              Case "12"
                MonthName="DEC"
          End Select
          
          
          ' MsgBox DY & MonthName & YR
          
          setCrntName = PCDPartProgram.FullName
          
          'my change In VPT.SE's code
          newname = PCDPartProgram.Path & "RESULTS\" &  PCDPartProgram.PartName & " - " & DY & MonthName & YR & " - " & SerialNo & ".PRG"
          'my change In code
          
          retval = PCDPartProgram.SaveAs(newname)
          retval = PCDPartProgram.SaveAs(setCrntName)
          
          ' Cleanup
          Set PCDPartProgram = Nothing
          Set PCDPartPrograms = Nothing
          Set PCDApp = Nothing
          End Sub
          Last edited by Moolvie; 03-17-2015, 12:46 PM.

          Comment


          • #6
            That vpt.se and his coding...
            PC-DMIS CAD++ 2o19 R1 SP4

            Comment


            • #7
              Credit where credit is due.

              Comment


              • #8
                Ok i am the biggest rookie there is at this,I need to save the program for each part i run from the same group of parts.This is so if i need to go back and change the way dimension are called out i can.The reason being is i check the parts they go to the customer and they check them.At that point some times they want them dimensioned a different way.The Zeiss software calypso does this automatically.Being new to the whole coding/ Script thing i have tried the listed codes but i can not seem to get them to do this.Do i have to lay them out a certain way in the script editor or copy paste and run? It appears to save the program but as the same program name just a different time saved

                Comment


                • #9
                  I believe the code for this is available here amongst the catacombs (serialized save-as).
                  PC-DMIS CAD++ 2o19 R1 SP4

                  Comment

                  Related Topics

                  Collapse

                  Working...
                  X