PC-Dmis to Excel, through PC-Dmis Script

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

  • PC-Dmis to Excel, through PC-Dmis Script

    I know there is currently a VB project that runs in Excel during execution that will pull information into the workbook during execution. I decided to venture out and try some of my own approaches with a combination of data I found online here and there.

    What I have is a script that can be executed in program, without too much setup and hassle, that will export data into an excel workbook like a print command would. I feel this script offers a little more versatility.

    I will not claim ownership of this program. I just tweaked it to fit my needs. So far I have it running, and it works quite well.

    I will answer what questions I can, but for the most part I wanted to post it to have as a reference.

    It's a long program........
    Last edited by Rploughe; 06-03-2015, 03:38 PM. Reason: Finalized

  • #2
    Code:
    Sub Main 
    'xl Declarations
    Dim xlApp As Object
    Dim xlWorkbooks As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    Dim fncSheet As Object
    Dim count As Integer
    Dim xlWorksheets As String 
    Dim xlWorksheet As String 
    'pcdlrn declarations And Open ppg
    Dim App As Object
    Set App = CreateObject("PCDLRN.Application")
    Dim Part As Object
    Set Part = App.ActivePartProgram
    Dim Cmds As Object
    Set Cmds = Part.Commands
    Dim Cmd As Object
    Dim DCmd As Object
    Dim DcmdID As Object
    Dim fs As Object 
    Dim DimID As String 
    Dim ReportDim As String
    Dim CheckDim As String 
    Dim Cavity As String  
    Dim myValue As String 
    Dim message, title, defaultValue As String
    Dim FolderList$ ( )  
    Set Project = Part.GetVariableValue("PROJECT")
    myValue = Project.StringValue
    If myValue = "" Then 
      myValue = InputBox("Please Input Project #","Project # Input","XXXXXX")
        For Each Cmd In Cmds
          If Cmd.Type = ASSIGNMENT Then
            If Cmd.GetText(DEST_EXPR,0) = "PROJECT" Then
          bln = Cmd.PutText("""" + myValue + """", SRC_EXPR, 0)
            Cmd.ReDraw
            End If
          End If
        Next Cmd
    End If
        Dim objFSO, objFolder, objShell, firstchar, InputFolder, found, objDLG
    myProject = "Project # " & myValue
        Dim serverpath
    'Hardcoded absolute 
        serverpath = "X:\" 'Path coded As a network directory In "My Computer" To point To projects folder
        'Assign searchpath using "serverpath"
        Dim foldername As String
        Dim strDirectory
        Dim strDirectory1
        Dim strDirectory2
        Dim strDirectory3
        Dim strDirectory4
        Dim strDirectory5
        foldername = Dir(serverpath & "*.*", 16) 'value of "16" pulls In all folders In directory given
    count = 0
    While foldername <> ""
    count = count +1
    checker = Left(foldername,6)
            If checker = myValue Then
                strDirectory = serverpath & foldername
                strDirectory1 = strDirectory & "\Non-Disclosure Agreement"
            End If
    foldername = Dir ' find the Next file
        Wend 
    'Create filesystemobject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Check If the folder "Non-Disclosure Agreement" exists
        If objFSO.FolderExists(strDirectory1) Then
            objFolder = objFSO.GetFolder(strDirectory1)
            found = 1
        Else
            strDirectory = strDirectory & "\"
            found = 0
        End If
        Dim CMDline, CMDvar, CMDval, Delimpos, CMDfind
        'Handle For "Non-Disclosure Agreement" Not existing
        If (found = 0) Then
            foldername = Dir(strDirectory & "*.*", 16) 'value of "16" pulls In all folders In directory given
            count = 0
            While foldername <> ""
                count = count + 1
                delimpos = instr(1, foldername, " ") 'Find the delimeter (space), "13 Eng" ex.
                If delimpos Then
                    CMDval = Right(foldername, 4)
                    If CMDval = "Engineering" Then
                        strDirectory1 = strDirectory & foldername
                    End If
                End If
                foldername = Dir ' find the Next file
            Wend 
        End If
        'Find "Engineering Folder"
        strDirectory1 = strDirectory1 & "\"
            foldername = Dir(strDirectory1 & "*.*", 16) 'value of "16" pulls In all folders In directory given
            count = 0
            While foldername <> ""
                count = count + 1
                delimpos = instr(1, foldername, " ") 'Find the delimeter (space), "13 Eng" ex.
                If delimpos Then
                    CMDval = Right(foldername,len(foldername) - delimpos)
                    If CMDval = "Engineering" Then
                    strDirectory2 = strDirectory1 & foldername
                    strDirectory3 = strDirectory2 & "\09 Inspection"
                    End If
                End If
                foldername = Dir ' find the Next file
           Wend 
        'Check If the folder "09 Inspection" exists
        If objFSO.FolderExists(strDirectory3) Then
            objFolder = objFSO.GetFolder(strDirectory3)
            found = 1
        Else
            strDirectory2 = strDirectory2 & "\"
            found = 0
        End If
        'Handle For "09 Inspection" Not existing
        If (found = 0) Then
            foldername = Dir(strDirectory2 & "*.*", 16) 'value of "16" pulls In all folders In directory given
            count = 0
            While foldername <> ""
                count = count + 1
                delimpos = instr(1, foldername, " ") 'Find the delimeter (space), "13 Eng" ex.
                If delimpos Then
                    CMDval = Right(foldername,len(foldername) - delimpos)
                    If CMDval = "Inspection" Then
                        strDirectory3 = strDirectory2 & foldername
                    End If
                End If
                foldername = Dir ' find the Next file
            Wend 
        End If
        'Find "CMM Data" Folder
        strDirectory3 = strDirectory3 & "\"
        foldername = Dir(strDirectory3 & "*.*", 16) 'value of "16" pulls In all folders In directory given
        count = 0
        founder = 0
        While foldername <> ""
            count = count + 1
            delimpos = instr(1, foldername, " ") 'Find the delimeter (space), "13 Eng" ex.
            If delimpos Then
                CMDval = Right(foldername,len(foldername) - delimpos)
                If CMDval = "CMM Programs & Documentation" Then
                    founder = 1
                    strDirectory4 = strDirectory3 & foldername
                    strDirectory5 = strDirectory4
                End If
            End If
            foldername = Dir ' find the Next file
        Wend 
        If (founder = 0) Then
            'Check If the folder "02 CMM Programs & Documentation" exists
            If objFSO.FolderExists(strDirectory5) Then
                objFolder = objFSO.GetFolder(strDirectory5)
            'Else
                objFolder = objFSO.CreateFolder(strDirectory5)
                objFolder = objFSO.GetFolder(strDirectory5)
            End If
        End If
        'If the folder existed
            'Check To see If results file exists
            FilePath = strDirectory5 & "\"
            Set prognam = Part.GetVariableValue("CMMPROGRAM")
            ResFileExists = FilePath & Prognam.StringValue & ".xlsx"
    Dim TempFilename
            If objFSO.FileExists(ResFileExists) = False Then
                TempFilename = "X:\00 Sub Folders\13 Engineering\09 Inspection\02 CMM Programs & Documentation\" & "Program Template.xlsx"
            Else
                TempFilename = FilePath & Prognam.StringValue & ".xlsx"
            End If
            On Error GoTo ErrorCheck
    Last edited by Rploughe; 06-09-2015, 09:01 AM.

    Comment


    • #3
      Code:
              'Open Excel And Base form
              Set xlApp = CreateObject("Excel.Application")
              Set xlWorkbooks = xlapp.Workbooks
              Set xlWorkbook = xlWorkbooks.Open(TempFilename)
              Set xlSheet = xlWorkbook.Worksheets("#Main Page")
              Set xlsheets = xlworkbook.worksheets
              Set fncSheet = xlApp.WorkSheetFunction
              Dim Nomi, Plustol, Minustol
              Dim sh As Worksheet, flg As Boolean
              For Each sh In xlworkbook.worksheets
                  If sh.Name = myProject Then flg = True : Exit For
              Next
              If flg = False Then
                  xlsheets.Add.Name = myProject
              End If
              Set xlSheet = xlWorkbook.Worksheets(myProject)
      If objFSO.FileExists(ResFileExists) = False Then
          RCount = 7
          CCount = 3
          Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
          Set Partnu = Part.GetVariableValue("PARTNUM")
          Set Partna = Part.GetVariableValue("PARTNAM")
          Set Printrevver = Part.GetVariableValue("PRINTREV1")
          xlSheet.Range("B1").Value = CMMPrognam.StringValue
          xlSheet.Range("A1").Value = "Program Name :"
          xlSheet.Range("B2").Value = Partnu.StringValue
          xlSheet.Range("A2").Value = "Part # :"
          xlSheet.Range("B3").Value = Partna.StringValue
          xlSheet.Range("A3").Value = "Part Name :"
          xlSheet.Range("B4").Value = Printrevver.StringValue
          xlSheet.Range("A4").Value = "Print Information :"
          Set Samp = Part.GetVariableValue("SAMP")
          xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
          xlSheet.Cells(RCount + 5, 1).Value = "Sample # : "
          xlSheet.Cells(RCount + 5, 2).Value = Samp.StringValue
          xlSheet.Cells(RCount + 0, 1).Value = "--"
          xlSheet.Cells(RCount + 1, 1).Value = "--"
          xlSheet.Cells(RCount + 2, 1).Value = "--"
          xlSheet.Cells(RCount + 3, 1).Value = "--"
          xlSheet.Cells(RCount + 1, 2).Value = "Nominal"
          xlSheet.Cells(RCount + 2, 2).Value = "USL"
          xlSheet.Cells(RCount + 3, 2).Value = "LSL"
          xlSheet.Cells(RCount + 4, 1).Value = "--"
          xlSheet.Cells(RCount + 4, 2).Value = "--"
      For Each Cmd In Cmds
               'Do GDT
               If Cmd.Type = 184 Then ' FCF
                    ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                         xlSheet.Cells(RCount-1,CCount).Value = Cmd.GetText (ID, 0) 
                         xlSheet.Cells(RCount,CCount).Value =  Cmd.GetText(GDT_SYMBOL, 0)
                         xlSheet.Cells(RCount+1,CCount).Value = "0"
                         xlSheet.Cells(RCount+2,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                         xlSheet.Cells(RCount+3,CCount).Value = "0"
                         xlSheet.Cells(RCount+4, CCount).Value = "--"
                         xlSheet.Cells(RCount+5, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
                    End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
                    CCount = CCount + 1
               End If
               'Do Dimensions
               If Cmd.IsDimension Then
                    If Cmd.Type = DIMENSION_START_LOCATION Or _
                         Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                          Set DcmdID = Cmd.DimensionCommand
                            DimID = DcmdID.ID
                            ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                            xlSheet.Cells(RCount - 1, CCount).Value = DcmdID.Id
                    End If
                    If Cmd.Type <> DIMENSION_START_LOCATION And _
                         Cmd.Type <> DIMENSION_END_LOCATION And _
                         Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                         Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                         Cmd.Type <> DATDEF_COMMAND Then
                          Set DCmd = Cmd.DimensionCommand
                          CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                         If CheckDim <> "" Then
                                  ReportDim = CheckDim
                         End If
                              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                   If DCmd.ID = "" Then
                                        xlSheet.Cells(RCount, CCount).Value = DCmd.AxisLetter
                                   Else
                                        xlSheet.Cells(RCount - 1, CCount).Value = Dcmd.Id
                                        xlSheet.Cells(RCount, CCount).Value = "M"
                                   End If 'DCmd.ID = ""
                                   xlSheet.Cells(RCount+1,CCount).Value = DCmd.Nominal
                                   Set PlusTol =  fncsheet.Sum(DCmd.Nominal,(DCmd.Plus))
                                   Set MinusTol = fncsheet.Sum(DCmd.Nominal,-(DCmd.Minus))
                                   xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
                                   xlSheet.Cells(RCount + 3, CCount).Value = MinusTol
                                   xlSheet.Cells(RCount+4, CCount).Value = "--"
                                   'Measured Or Deviation With check For True Position
                                   If DCmd.AxisLetter <> "TP" Then
                                        xlSheet.Cells(RCount+5, CCount).Value = DCmd.Measured
                                   Else
                                        xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                                   End If 'DCmd.AxisLetter <> "TP" 
                                   'Add For Profile dimensions
                                   If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                        xlSheet.Cells(RCount+5, CCount).Value = DCmd.Deviation
                                   End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                              CCount = CCount + 1
                    End If
               End If
      Next Cmd
      Else 'If ResFileExists = False Then
           If objFSO.FileExists(ResFileExists) = True Then 
          RCount = 11
          Found = 0
          Do Until Found = 1
          RCount = RCount + 1
          If xlSheet.Cells(RCount,1).Value = "" Then
          Found=Found+1
          End If
          Loop
          Samp = Part.GetVariableValue("SAMP")
          xlSheet.Cells(RCount, 1).Value = "Sample # :"
          xlSheet.Cells(RCount, 2).Value = Samp.StringValue
          'Fill In measured data
          CCount = 3
      For Each Cmd In Cmds
               'Do GDT
               If Cmd.Type = 184 Then ' FCF
                    ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                    If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                         xlSheet.Cells(RCount, CCount).Value = Cmd.GetText(LINE2_DEV, 1)
                    End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
                    CCount = CCount + 1
               End If
               'Do Dimensions
               If Cmd.IsDimension Then
                    If Cmd.Type = DIMENSION_START_LOCATION Or _
                         Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                          Set DcmdID = Cmd.DimensionCommand
                            DimID = DcmdID.ID
                            ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                    End If
                    If Cmd.Type <> DIMENSION_START_LOCATION And _
                         Cmd.Type <> DIMENSION_END_LOCATION And _
                         Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                         Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                         Cmd.Type <> DATDEF_COMMAND Then
                          Set DCmd = Cmd.DimensionCommand
                          CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                         If CheckDim <> "" Then
                                  ReportDim = CheckDim
                         End If
                              If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                   'Measured Or Deviation With check For True Position
                                   If DCmd.AxisLetter <> "TP" Then
                                        xlSheet.Cells(RCount, CCount).Value = DCmd.Measured
                                   Else
                                        xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                                   End If 'DCmd.AxisLetter <> "TP" 
                                   'Add For Profile dimensions
                                   If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                        xlSheet.Cells(RCount, CCount).Value = DCmd.Deviation
                                   End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                              End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                              CCount = CCount + 1
                    End If
               End If
      Next Cmd
              End If
      End If 'If ResFileExists = False Then
      Last edited by Rploughe; 06-09-2015, 09:05 AM.

      Comment


      • #4
        Code:
        If objFSO.FileExists(ResFileExists) = True Then
            Dim Aver, Mini, Maxi, StdDevv, Ranger, Meani, Cp, Cpk
            Dim MyRange As Range
            Dim Startcell, EndCell, Tcount, Scount
            Dim Col, lCol
            Rcount = Rcount
         Ccount = 3
         Scount = 12
         Tcount = Rcount-Scount
            Rcount = Rcount+2
            xlsheet.cells(Rcount-1,1).Value = ""
            xlsheet.cells(Rcount+0,1).Value = "Max"
            xlsheet.cells(Rcount+1,1).Value = "Min"
            xlsheet.cells(Rcount+2,1).Value = "Range"
            xlsheet.cells(Rcount+3,1).Value = "--"
            xlsheet.cells(Rcount+4,1).Value = "Average"
            xlsheet.cells(Rcount+5,1).Value = "Mean"
            xlsheet.cells(Rcount+6,1).Value = "Std Dev"
            xlsheet.cells(Rcount+7,1).Value = "--"
            xlsheet.cells(Rcount+8,1).Value = "Cp"
            xlsheet.cells(Rcount+9,1).Value = "CpK"
            xlsheet.cells(Rcount+10,1).Value = "Count"
            xlsheet.cells(Rcount-1,2).Value = "--"
            xlsheet.cells(Rcount+0,2).Value = "--"
            xlsheet.cells(Rcount+1,2).Value = "--"
            xlsheet.cells(Rcount+2,2).Value = "--"
            xlsheet.cells(Rcount+3,2).Value = "--"
            xlsheet.cells(Rcount+4,2).Value = "--"
            xlsheet.cells(Rcount+5,2).Value = "--"
            xlsheet.cells(Rcount+6,2).Value = "--"
            xlsheet.cells(Rcount+7,2).Value = "--"
            xlsheet.cells(Rcount+8,2).Value = "--"
            xlsheet.cells(Rcount+9,2).Value = "--"
            xlsheet.cells(Rcount+10,2).Value = "--"    NotFound = 0
            Do Until NotFound = 1
                 If xlSheet.Cells(7, CCount).Value <> "" Then ' FCF
                 xlsheet.cells(Rcount-1,Ccount).Value = "--"
                 xlsheet.cells(Rcount+0,Ccount).Value = fncsheet.Max(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                 xlsheet.cells(Rcount+1,Ccount).Value = fncsheet.Min(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                 'Controls Range of Meas, Max-Min
                 xlsheet.cells(Rcount+2,Ccount).Value = fncsheet.Sum(xlsheet.Cells(Rcount+0,Ccount).value,-(xlsheet.Cells(Rcount+1,Ccount).value))
                 xlsheet.cells(Rcount+3,Ccount).Value = "--"
                 xlsheet.cells(Rcount+4,Ccount).Value = fncsheet.Average(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                 xlsheet.cells(Rcount+5,Ccount).Value = fncsheet.Median(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                 xlsheet.cells(Rcount+6,Ccount).Value = fncsheet.STDEVP(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                 xlsheet.cells(Rcount+7,Ccount).Value = "--"
                 If xlsheet.cells(10,Ccount).Value <> 0 Then
                      xlsheet.cells(Rcount+8,Ccount).Value = _
                           (xlsheet.cells(9,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
                      xlsheet.cells(Rcount+9,Ccount).Value = fncsheet.Min( _
                           (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value) _
                           ,(xlsheet.cells(Rcount+4,Ccount).Value-xlsheet.cells(10,Ccount).Value)/(3*xlsheet.cells(Rcount+6,Ccount).value))
                 Else
                      xlsheet.cells(Rcount+8,Ccount).Value = _
                           (xlsheet.cells(9,Ccount).Value)/(6*xlsheet.cells(Rcount+6,Ccount).value)
                      xlsheet.cells(Rcount+9,Ccount).Value = _
                           (xlsheet.cells(9,Ccount).Value-xlsheet.cells(Rcount+4,Ccount).Value) /(3*xlsheet.cells(Rcount+6,Ccount).value)
                 End If
                      xlsheet.cells(Rcount+10,Ccount).Value = Rcount-Scount-1
                 CCount = CCount + 1
                 NotFound = 0
                 Else 
                 NotFound = 1
                 End If 
        Loop
        End If
        'Save And Cleanup
        If objFSO.FileExists(ResFileExists) = False Then
            xlWorkBook.SaveAs ResFileExists
        Else
            xlWorkBook.Save
        End If
            Set xlSheet = Nothing 
        xlWorkbook.Close
            Set xlWorkbook = Nothing 
        xlWorkbooks.Close 
            Set xlWorkbooks = Nothing 
        xlApp.Quit
            Set xlApp = Nothing
        Exit Sub
        ErrorCheck:
        Set xlSheet = Nothing 
        xlWorkbook.Close
            Set xlWorkbook = Nothing 
        xlWorkbooks.Close 
            Set xlWorkbooks = Nothing 
        xlApp.Quit
            Set xlApp = Nothing
        End Sub
        Last edited by Rploughe; 06-09-2015, 09:06 AM.

        Comment


        • #5
          There the monster is finished.

          I can personally say it was fun writing this.

          The first section posted goes through my company directory by a pulled variable and locations to find my end "address"
          the second section posted actually controls all the excel population. Still needs cleaned up.
          The third section is the final part of the program for clean up, and formula crunching.

          If you have any questions, I will answer what I can.

          ---------
          I had some time and decided to play with the excel functions some more. Finding the correct syntax for the "Excel" "WorkbookFunction" was a little annoying but I got it. I also figured out how to properly select a cell range for data crunching.

          Not sure if my formula for Cp, CpK are correct. I did it off of memory real quick.

          So here you go, a working excel output script with examples on excel function/formula implementation. There are other logic statements I have been playing with like cell shading and cell width/height. Once I get a "neat" layout I will post them.
          -------
          Code:
          Dim WidthSet
           WidthSet = xlSheet.Range("A4").Columns.AutoFit()
          WidthSet = xlSheet.Cells(RCount - 1, 2).Columns.AutoFit()
          ^Controls to AutoSet Cell Width for information display length
          Code:
          If xlsheet.Cells(RCount+5,CCount).value > xlsheet.cells(Rcount+2,Ccount).Value Then
               xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
          End If
          ^Controls to AutoSet Cell Shade based on cell value comparatively.
          Code:
          objExcel.Cells(1, 2).Font.ColorIndex = 44
          ^Controls to AutoSet Cell Text Color.
          Code:
          Set objExcel = CreateObject("Excel.Application")
          objExcel.Visible = True
          Set objWorkbook = objExcel.Workbooks.Add()
          Set objWorksheet = objWorkbook.Worksheets(1)
          
          For i = 1 to 14
              objExcel.Cells(i, 1).Value = i
              objExcel.Cells(i, 2).Interior.ColorIndex = i
          Next
          
          For i = 15 to 28
              objExcel.Cells(i - 14, 3).Value = i
              objExcel.Cells(i - 14, 4).Interior.ColorIndex = i
          Next
          
          For i = 29 to 42
              objExcel.Cells(i - 28, 5).Value = i
              objExcel.Cells(i - 28, 6).Interior.ColorIndex = i
          Next
          
          For i = 43 to 56
              objExcel.Cells(i - 42, 7).Value = i
              objExcel.Cells(i - 42, 8).Interior.ColorIndex = i
          Next
          ^Code snippet to determine color code
          Last edited by Rploughe; 06-10-2015, 08:34 AM.

          Comment


          • #6
            Noob (to VB) question here, do I just copy this into VB to make this work?
            Brown and Sharpe Mistral---B&S Micro Excel
            PH10M / TP20
            PHC10-2
            PCDMIS MR1 2009 --- PCDMIS 2012MR1 Cad++

            Comment


            • #7
              ...... it won't be that easy.

              I could post a more user-friendly copy, but this was more of a reference/guide to using excel from the basic script commands. I found the pcd2excel wizard in pcdmis not very friendly to custom/modified outputs.

              I can help you with questions. pm me.
              Last edited by Rploughe; 10-03-2018, 10:29 AM.

              Comment


              • #8
                Drop-In Script part1

                Code:
                Sub Main 
                'pcdlrn declarations And Open ppg
                Dim App As Object
                Set App = CreateObject("PCDLRN.Application")
                Dim Part As Object
                Set Part = App.ActivePartProgram
                Dim Ew As Object
                Set Ew = Part.EditWindow
                Dim Cmds As Object
                Set Cmds = Part.Commands
                Dim Cmd As Object
                Dim DCmd As Object
                Dim DcmdID As Object
                Dim ObjFso
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                'Excel Declarations
                Dim xlApp As Object
                Set xlApp = CreateObject("Excel.Application")
                Dim xlWorkbooks As Object
                Set xlWorkbooks = xlapp.Workbooks
                Dim xlWorkbook As Object
                Dim xlSheet As Object
                Dim fncSheet As Object
                Dim count As Integer
                Dim xlWorksheets As String 
                Dim xlWorksheet As String 
                Dim DimID As String 
                Dim ReportDim As String
                Dim CheckDim As String 
                Dim FilePath, SheetPath As String
                'Check To see If results file exists
                myTitle$ = "User Input"
                Prompt$ = "Please Input Directory for blank Excel Document, or Reference Document.  Including file name."
                Default$ = "C:\"
                FilePath = InputBox$(Prompt$, myTitle$, Default$)
                myTitle$ = "User Input"
                Prompt$ = "Please Input Sheet Name for Data Population"
                Default$ = "Sheet1"
                SheetPath = InputBox$(Prompt$, myTitle$, Default$)
                ResFileExists = FilePath & ".xlsx"
                Dim TempFilename,TempSheetName
                TempSheetName = SheetPath
                If objFSO.FileExists(ResFileExists) = False Then
                    'If the file did Not exist, Then use a default file location stored As a precaution
                    TempFilename = "X:\00 Sub Folders\13 Engineering\09 Inspection\02 CMM Programs & Documentation\" & "Prog Template.xlsx"
                    '^^ You need to adjust this line to fit your needs.  This is a security line to always point to a guaranteed excel document for use. _
                    'Ex.  "C:\Test.xlsx"
                Else
                    TempFilename = ResFileExists
                End If
                On Error GoTo ErrorCheck
                Last edited by Rploughe; 07-13-2015, 09:22 AM.

                Comment


                • #9
                  Drop-in Script Part2
                  Code:
                   
                  'Open Excel And Base form
                  'Display Excel, While hiding Pc-Dmis
                  xlApp.Application.Visible = True
                  App.Visible = False
                  Set xlWorkbook = xlWorkbooks.Open(TempFilename)
                  Set xlsheets = xlworkbook.worksheets
                  'by default first sheet is "Sheet1" In a workbook.  If you save a default template_
                  'Then you need To adjust the following Set xlsheet assignment To match
                  Set xlSheet = xlWorkbook.Worksheets("Sheet1")
                  Set fncSheet = xlApp.WorkSheetFunction
                  'Pc-Dmis Variable Call-In
                  Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
                  Set Partnu = Part.GetVariableValue("PARTNUMBER")
                  Set Partna = Part.GetVariableValue("PARTNAME")
                  Set Printrevver = Part.GetVariableValue("PRINTREV1")
                  Set Samp = Part.GetVariableValue("SAMP")
                  Dim sh As Worksheet, flg As Boolean
                  Dim Nomi, Plustol, Minustol, Meas, WidthSet
                  'Search the Open workbook For a sheet Name
                  For Each sh In xlworkbook.worksheets
                      If sh.Name = SheetPath Then flg = True : Exit For
                  Next
                  'If sheet is Not found, add one
                  If flg = False Then
                      xlsheets.Add.Name = SheetPath
                  End If
                  'Asssign sheet Name To be populated
                  Set xlSheet = xlWorkbook.Worksheets(SheetPath)
                  'If the file did Not exist, start execution To populate main data
                  If objFSO.FileExists(ResFileExists) = False Or xlsheet.cells(1,1).Value = "" Then
                      RCount = 7
                      CCount = 3
                      xlSheet.Range("B1").Value = CMMPrognam.StringValue
                      xlSheet.Range("A1").Value = "Program Name :"
                      xlSheet.Range("B2").Value = Partnu.StringValue
                      xlSheet.Range("A2").Value = "Part # :"
                      xlSheet.Range("B3").Value = Partna.StringValue
                      xlSheet.Range("A3").Value = "Part Name :"
                      xlSheet.Range("B4").Value = Printrevver.StringValue
                      xlSheet.Range("A4").Value = "Print Information :"
                      WidthSet = xlSheet.Range("A4").Columns.AutoFit()
                  
                      xlSheet.Cells(RCount - 1, 2).Value = "Feature Name :"
                      WidthSet =     xlSheet.Cells(RCount - 1, 2).Columns.AutoFit()
                      xlSheet.Cells(RCount + 5, 1).Value = "Sample # : "
                      xlSheet.Cells(RCount + 5, 2).Value = Samp.StringValue
                      xlSheet.Cells(RCount + 0, 1).Value = "--"
                      xlSheet.Cells(RCount + 1, 1).Value = "--"
                      xlSheet.Cells(RCount + 2, 1).Value = "--"
                      xlSheet.Cells(RCount + 3, 1).Value = "--"
                      xlSheet.Cells(RCount + 1, 2).Value = "Nominal"
                      xlSheet.Cells(RCount + 2, 2).Value = "USL"
                      xlSheet.Cells(RCount + 3, 2).Value = "LSL"
                      xlSheet.Cells(RCount + 4, 1).Value = "--"
                      xlSheet.Cells(RCount + 4, 2).Value = "--"
                      i = 0
                      For Each Cmd In Cmds
                           i = i + 1
                           App.StatusBar = "Cycling through commands. Current command: " & i
                           'Do GDT
                           If Cmd.Type = 184 Then ' FCF
                                ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                                If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                     xlSheet.Cells(RCount-1,CCount).Value = Cmd.GetText (ID, 0) 
                                     xlSheet.Cells(RCount,CCount).Value =  Cmd.GetText(GDT_SYMBOL, 0)
                                     xlSheet.Cells(RCount+1,CCount).Value = "0"
                                     xlSheet.Cells(RCount+2,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
                                     xlSheet.Cells(RCount+3,CCount).Value = "0"
                                     xlSheet.Cells(RCount+4, CCount).Value = "--"
                                     xlSheet.Cells(RCount+5, CCount).Value = fncsheet.Round(Cmd.GetText(LINE2_DEV, 1),6)
                                     If xlsheet.Cells(RCount+5,CCount).value > xlsheet.cells(Rcount+2,Ccount).Value Then
                                          xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                                     End If
                                     WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
                                     WidthSet = xlSheet.Cells(RCount,CCount).Columns.AutoFit()
                                End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
                                CCount = CCount + 1
                           End If
                           'Do Dimensions
                           If Cmd.IsDimension Then
                                If Cmd.Type = DIMENSION_START_LOCATION Or _
                                     Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                                          Set DcmdID = Cmd.DimensionCommand
                                          DimID = DcmdID.ID
                                          ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                          xlSheet.Cells(RCount - 1, CCount).Value = DcmdID.Id
                                          WidthSet = xlSheet.Cells(RCount-1,CCount).Columns.AutoFit()
                                End If
                                If Cmd.Type <> DIMENSION_START_LOCATION And _
                                     Cmd.Type <> DIMENSION_END_LOCATION And _
                                     Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                                     Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                                     Cmd.Type <> DATDEF_COMMAND Then
                                     Set DCmd = Cmd.DimensionCommand
                                     CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                     If CheckDim <> "" Then
                                          ReportDim = CheckDim
                                     End If
                                     If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                          If DCmd.ID = "" Then
                                               xlSheet.Cells(RCount, CCount).Value = DCmd.AxisLetter
                                          Else
                                               xlSheet.Cells(RCount - 1, CCount).Value = Dcmd.Id
                                               xlSheet.Cells(RCount, CCount).Value = "M"
                                          End If 'DCmd.ID = ""
                                          If Dcmd.Nominal < 0 Then
                                               Set Nomi = Abs(DCmd.Nominal)
                                               Set PlusTol =  fncsheet.Sum(Nomi,Abs((DCmd.Plus)))
                                               Set MinusTol = fncsheet.Sum(Nomi,-Abs((DCmd.Minus)))
                                          Else
                                               Set Nomi = DCmd.Nominal
                                               Set PlusTol =  fncsheet.Sum(Nomi,(DCmd.Plus))
                                               Set MinusTol = fncsheet.Sum(Nomi,-(DCmd.Minus))
                                          End If
                                          xlSheet.Cells(RCount+1,CCount).Value = Nomi
                                          xlSheet.Cells(RCount + 2, CCount).Value = PlusTol
                                          xlSheet.Cells(RCount + 3, CCount).Value = MinusTol
                                          xlSheet.Cells(RCount+4, CCount).Value = "--"
                                          'Measured Or Deviation With check For True Position
                                          If DCmd.AxisLetter <> "TP" Then
                                               Set Meas = Abs(fncsheet.Round(DCmd.Measured,6))
                                               xlSheet.Cells(RCount+5, CCount).Value = Meas
                                               If Meas > PlusTol Or _
                                               Meas < MinusTol Then
                                                    xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                                               End If
                                          Else
                                               Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                                               xlSheet.Cells(RCount+5, CCount).Value = Meas
                                               If Meas > PlusTol Or _
                                               Meas < MinusTol Then
                                                    xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                                               End If
                                          End If 'DCmd.AxisLetter <> "TP" 
                                          'Add For Profile dimensions
                                          If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                               Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                                               xlSheet.Cells(RCount+5, CCount).Value = Meas
                                               If xlsheet.Cells(RCount+5,CCount).value > PlusTol Or _
                                               xlsheet.Cells(RCount+5,CCount).value < MinusTol Then
                                                    xlsheet.Cells(RCount+5,Ccount).Interior.ColorIndex = 38
                                               End If
                                          End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                                     End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                                     CCount = CCount + 1
                                End If
                           End If
                      Next Cmd

                  Comment


                  • #10
                    Drop-In Script Part3
                    Code:
                    Else 'If ResFileExists = False Then
                        If objFSO.FileExists(ResFileExists) = True Then 
                             RCount = 11
                             Found = 0
                             Do Until Found = 1
                                  RCount = RCount + 1
                                  If xlSheet.Cells(RCount,1).Value = "" Then
                                       Found=Found+1
                                  End If
                             Loop
                             xlSheet.Cells(RCount, 1).Value = "Sample # :"
                             xlSheet.Cells(RCount, 2).Value = Samp.StringValue
                             'Fill In measured data
                             CCount = 3
                             i = 0
                             For Each Cmd In Cmds
                                  i = i + 1
                                  App.StatusBar = "Cycling through commands. Current command: " & i
                                  'Do GDT
                                  If Cmd.Type = 184 Then ' FCF
                                       ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                                       If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                            xlSheet.Cells(RCount, CCount).Value = fncsheet.Round(Cmd.GetText(LINE2_DEV, 1),6)
                                            If xlsheet.Cells(RCount,CCount).value > xlsheet.cells(9,Ccount).Value Or _
                                                 xlsheet.Cells(RCount,CCount).value < xlsheet.cells(10,Ccount).Value Then
                                                 xlsheet.Cells(RCount,Ccount).Interior.ColorIndex = 38
                                            End If
                                       End If 'ReportDim = "BOTH" Or ReportDim = "REPORT" 
                                       CCount = CCount + 1
                                  End If
                                  'Do Dimensions
                                  If Cmd.IsDimension Then
                                       If Cmd.Type = DIMENSION_START_LOCATION Or _
                                            Cmd.Type = DIMENSION_TRUE_START_POSITION Then
                                            Set DcmdID = Cmd.DimensionCommand
                                            DimID = DcmdID.ID
                                            ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                       End If
                                       If Cmd.Type <> DIMENSION_START_LOCATION And _
                                            Cmd.Type <> DIMENSION_END_LOCATION And _
                                            Cmd.Type <> DIMENSION_TRUE_START_POSITION And _
                                            Cmd.Type <> DIMENSION_TRUE_END_POSITION And _
                                            Cmd.Type <> DATDEF_COMMAND Then
                                            Set DCmd = Cmd.DimensionCommand
                                            CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
                                            If CheckDim <> "" Then
                                                 ReportDim = CheckDim
                                            End If
                                            If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                                                 Set PlusTol =  xlSheet.Cells(9, CCount).Value
                                                 Set MinusTol = xlSheet.Cells(10, CCount).Value
                                                 'Measured Or Deviation With check For True Position
                                                 If DCmd.AxisLetter <> "TP" Then
                                                      Set Meas = Abs(fncsheet.Round(DCmd.Measured,6))
                                                      xlSheet.Cells(RCount, CCount).Value = Meas
                                                      If Meas > PlusTol Or _
                                                      Meas < MinusTol Then
                                                           xlsheet.Cells(RCount,Ccount).Interior.ColorIndex = 38
                                                      End If
                                                 Else
                                                      Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                                                      xlSheet.Cells(RCount, CCount).Value = Meas
                                                      If Meas > PlusTol Or _
                                                      Meas < MinusTol Then
                                                           xlsheet.Cells(RCount,Ccount).Interior.ColorIndex = 38
                                                      End If
                                                 End If 'DCmd.AxisLetter <> "TP" 
                                                 'Add For Profile dimensions
                                                 If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
                                                      Set Meas = Abs(fncsheet.Round(DCmd.Deviation,6))
                                                      xlSheet.Cells(RCount, CCount).Value = Meas
                                                      If Meas > PlusTol Or _
                                                      Meas < MinusTol Then
                                                           xlsheet.Cells(RCount,Ccount).Interior.ColorIndex = 38
                                                      End If
                                                 End If 'Cmd.Type = 1118 Or Cmd.Type = 1105 
                                            End If 'ReportDim = "BOTH" Or ReportDim = "REPORT"
                                            CCount = CCount + 1
                                       End If
                                  End If
                             Next Cmd
                        End If
                    End If 'If ResFileExists = False Then
                    'Optional sheet functions used For data gathering.  'Will Not work If there are blank values.  Delete out the following Or use As needed.
                    If objFSO.FileExists(ResFileExists) = True And Rcount >= 13 Then
                        Dim Aver, Mini, Maxi, Std, Cp, Cpk, usl, lsl
                        Dim Startcell, EndCell, Tcount, Scount
                        Dim Col, lCol
                        Rcount = Rcount
                        Ccount = 3
                        Scount = 12
                        Tcount = Rcount-Scount
                        Rcount = Rcount+2
                        xlsheet.cells(Rcount-1,1).Value = ""
                        xlsheet.cells(Rcount+0,1).Value = "Max"
                        xlsheet.cells(Rcount+1,1).Value = "Min"
                        xlsheet.cells(Rcount+2,1).Value = "Range"
                        xlsheet.cells(Rcount+3,1).Value = "--"
                        xlsheet.cells(Rcount+4,1).Value = "Average"
                        xlsheet.cells(Rcount+5,1).Value = "Mean"
                        xlsheet.cells(Rcount+6,1).Value = "Std Dev"
                        xlsheet.cells(Rcount+7,1).Value = "--"
                        'xlsheet.cells(Rcount+8,1).Value = "Cp"
                        'xlsheet.cells(Rcount+9,1).Value = "CpK"
                        xlsheet.cells(Rcount+8,1).Value = "Count"
                        xlsheet.cells(Rcount+8,2).Value = Rcount-Scount-1
                        xlsheet.cells(Rcount-1,2).Value = "--"
                        xlsheet.cells(Rcount+0,2).Value = "--"
                        xlsheet.cells(Rcount+1,2).Value = "--"
                        xlsheet.cells(Rcount+2,2).Value = "--"
                        xlsheet.cells(Rcount+3,2).Value = "--"
                        xlsheet.cells(Rcount+4,2).Value = "--"
                        xlsheet.cells(Rcount+5,2).Value = "--"
                        xlsheet.cells(Rcount+6,2).Value = "--"
                        xlsheet.cells(Rcount+7,2).Value = "--"
                        'xlsheet.cells(Rcount+8,2).Value = "--"
                        'xlsheet.cells(Rcount+9,2).Value = "--"
                        'xlsheet.cells(Rcount+10,2).Value = "--"
                        NotFound = 0
                        Do Until NotFound = 1
                             If xlSheet.Cells(7, CCount).Value <> "" Then ' FCF
                                  xlsheet.cells(Rcount-1,Ccount).Value = "--"
                                  Set USL = xlsheet.cells(9,Ccount).Value
                                  Set LSL = xlsheet.cells(10,Ccount).Value
                                  xlsheet.cells(Rcount+0,Ccount).Value = fncsheet.Max(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                                  Set Maxi = xlsheet.cells(Rcount+0,Ccount).Value
                                  xlsheet.cells(Rcount+1,Ccount).Value = fncsheet.Min(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                                  Set Mini = xlsheet.cells(Rcount+1,Ccount).Value
                                  'Controls Range of Meas, Max-Min
                                  xlsheet.cells(Rcount+2,Ccount).Value = fncsheet.Round(fncsheet.Sum(xlsheet.Cells(Rcount+0,Ccount).value,-(xlsheet.Cells(Rcount+1,Ccount).value)),6)
                                  xlsheet.cells(Rcount+3,Ccount).Value = "--"
                                  xlsheet.cells(Rcount+4,Ccount).Value = fncsheet.Average(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                                  Set Aver = xlsheet.cells(Rcount+4,Ccount).Value
                                  xlsheet.cells(Rcount+5,Ccount).Value = fncsheet.Median(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount))))
                                  xlsheet.cells(Rcount+6,Ccount).Value = fncsheet.Round(fncsheet.STDEVP(xlsheet.Range(xlsheet.cells(Scount,Ccount),(xlsheet.cells(Scount+Tcount,Ccount)))),6)
                                  Set Std = xlsheet.cells(Rcount+6,Ccount).Value
                                  xlsheet.cells(Rcount+7,Ccount).Value = "--"
                                  xlsheet.cells(Rcount+8,Ccount).Value = "--"
                                  'xlsheet.cells(Rcount+8,Ccount).Value =""
                                  'xlsheet.cells(Rcount+9,Ccount).Value =""
                                  'xlsheet.cells(Rcount+8,Ccount).Value = fncsheet.Round(((USL-LSL)/(6*Std)),6)
                                  'If LSL <> 0 Then
                                       'xlsheet.cells(Rcount+9,Ccount).Value = fncsheet.Round(fncsheet.Min(((USL-Aver)/(3*Std)),((Aver-LSL)/(3*Std))),6)
                                  'Else
                                       'xlsheet.cells(Rcount+9,Ccount).Value = fncsheet.Round((USL-Aver)/(3*Std),6)
                                  'End If
                                  'xlsheet.cells(Rcount+10,Ccount).Value = Rcount-Scount-1
                                  CCount = CCount + 1
                                  NotFound = 0
                             Else 
                                  NotFound = 1
                             End If 
                        Loop
                    End If
                    '^^Optional sheet functions used For data gathering.  'Will Not work If there are blank values.  Delete out the following Or use As needed^^.
                    'Save And Cleanup
                    If objFSO.FileExists(ResFileExists) = False Then
                        'If the file did Not exist originally, save the file As the Name given
                        xlWorkBook.SaveAs ResFileExists
                    Else
                        xlWorkBook.Save
                    End If
                    xlApp.Application.Visible = False
                    App.Visible = True
                    Set xlSheet = Nothing 
                    xlWorkbook.Close
                    Set xlWorkbook = Nothing 
                    xlWorkbooks.Close 
                    Set xlWorkbooks = Nothing 
                    xlApp.Quit
                    Set xlApp = Nothing
                    Exit Sub
                    ErrorCheck:
                    xlApp.Application.Visible = True
                    App.Visible = True
                    Set xlSheet = Nothing 
                    Set xlWorkbook = Nothing 
                    Set xlWorkbooks = Nothing 
                    Set xlApp = Nothing
                    End Sub

                    Comment


                    • #11
                      Above is a 3 part drop in script. You will need to copy and paste it all together.

                      Note 1: If you notice in the first section, you need to add a default excel file for reference as a security means.
                      Note 2: The version of excel you are using is important. As Default it uses the extension .xlsx
                      Note 3: The following code snippet requires these variables in your Pc-Dmis program to be implemented. If you want to use the default program data, that can be done as well. Just change the code.
                      Set CMMPrognam = Part.GetVariableValue("CMMPROGRAM")
                      Set Partnu = Part.GetVariableValue("PARTNUMBER")
                      Set Partna = Part.GetVariableValue("PARTNAME")
                      Set Printrevver = Part.GetVariableValue("PRINTREV1")
                      Set Samp = Part.GetVariableValue("SAMP")
                      Note 4: The optional math functions are for your use. If you don't want them, delete them out. BUT! you can't leave them in there if you dry run. throws zeroes out and causes errors.
                      Note 5: Please notice that even if you dim out in negatives, everything in this script uses Abs values and rounds out to 6 places. For the math functions to work, it had to be done.
                      Note 6: Your dimensions can't be 0 +/- tol. For obvious reasons, your averages and other values will be wrong. So you may use dimensions like this, but you can't use the math functions.
                      Last edited by Rploughe; 07-13-2015, 09:32 AM.

                      Comment


                      • #12
                        Hi, thanks for this scipt.
                        It works fine for me if I switch PCDMIS to english language. If I use it with german language than it exports only some of the dimension labels and no single measurement. Do you have any suggestion what to change to make it run in other languages than english?

                        Comment


                        • #13
                          Hello Ralf,

                          Honestly that is beyond my scripting experience. I know there are some on here who have/can do this. So i apologize and hope that one of the more experienced users on here can answer your question.

                          Comment


                          • #14
                            Hello Rploughe,

                            thats ok, maybe one of the specialists will post an answer.
                            In the meantime I am in contact with the german support team and ask them about the differences between scrips for english and german version of PCDMIS. But I still have no answer. So lets wait and see.

                            Comment


                            • #15
                              For every place where a GETTEXT-result is compared to a "text" you need to verify the German translation of that text. Like in

                              Code:
                              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                                            If ReportDim = "BOTH" Or ReportDim = "REPORT" Then
                              For Swedish, the "BOTH" should be "BÅDA" and "REPORT" should be "RAPPORT", my guess for German is "BEIDE" and "RAPPORT".

                              I often write scripts that work both in English and Swedish, the above excerpt would then be changed to

                              Code:
                              ReportDim = Cmd.GetText(OUTPUT_TYPE, 0)
                                            If ReportDim = "BOTH" Or ReportDim = "REPORT" Or ReportDim = "BÅDA" or ReportDim = "RAPPORT" Then
                              which gets rather unwieldy when more languages are needed.


                              In the latest versions of PC-DMIS there is a function for getting a string in the current language, given the English word,

                              Code:
                                ASSIGN/V1=GETSETTING("Langstr(Yes)")
                              will give "JA" when I run in Swedish, but this function is very limited in its vocabulary, and "BOTH" is not there so you have to use a numeric ID instead - good luck finding the numbers, there are about 10000 different ones (-4000 to +6000, approx.)...
                              Last edited by AndersI; 08-03-2015, 08:46 AM.
                              AndersI
                              SW support - Hexagon Metrology Nordic AB

                              Comment

                              Related Topics

                              Collapse

                              Working...
                              X