help：Using scripts to acquire FCF data

Question

该脚本能够输出FCF数据；然而，作为一名质量控制专业人员，我不熟悉如何修改其代码以确保其输出完整的内容，包括位置公差、轮廓公差和XY信息。帮助。 
 
 谢谢。

WilliamL · Accepted Answer

THEO_X, THEO_Y, and THEO_Z worked for me. I used PCDMIS 2018 R2, as I do not have 2017 to check specifically for your version.

There is a lot of random formatting things I was testing, but the important things for you are the portions of the code in the Case 2 FCF Block

Sub Main()
  ' writes Dimension-data To excel sheet
  ' the excel sheet must be saved manually
  
  ' Dim Something
    Dim pcDMISApp As Object
    Set pcDMISApp = CreateObject("PCDLRN.Application")
    Dim pcDMISPart As Object
    Set pcDMISPart = pcDMISApp.ActivePartProgram
    Dim pcDMISCmds As Object
    Set pcDMISCmds = pcDMISPart.Commands
    Dim pcDMISCmd As Object
    Dim pcDMISDIMCmd As Object
  
    Dim objExcel As Object
    Dim objNewBook As Object
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    Dim sPath, sTemp, sTemp2 As String
    Dim iRowCount, iIndex, iType As Integer
    Dim dMeas, dTol, dMin, dMax, dDev, dNominal As Double

  ' Write excel heading
    objExcel.ScreenUpdating = False
    objNewBook.Sheets(1).Cells(1, 1).Value = "ID"
    objNewBook.Sheets(1).Cells(1, 2).Value = "Ref"
    objNewBook.Sheets(1).Cells(1, 3).Value = "AxisLetter"
    objNewBook.Sheets(1).Cells(1, 4).Value = "Nominal"    
    objNewBook.Sheets(1).Cells(1, 5).Value = "Measured"
    objNewBook.Sheets(1).Cells(1, 6).Value = "Plus"
    objNewBook.Sheets(1).Cells(1, 7).Value = "Minus"
    objNewBook.Sheets(1).Cells(1, 8).Value = "OutTol"
    objNewBook.Sheets(1).Cells(1, 9).Value = "Length"
    objNewBook.Sheets(1).Cells(1, 10).Value = "Deviation"
    objNewBook.Sheets(1).Cells(1, 11).Value = "Max"
    objNewBook.Sheets(1).Cells(1, 12).Value = "Min"
    objNewBook.Sheets(1).Cells(1, 13).Value = "Theo X"
    objNewBook.Sheets(1).Cells(1, 14).Value = "Theo Y"
    objNewBook.Sheets(1).Cells(1, 15).Value = "Theo Z"
    objNewBook.Sheets(1).Cells(1, 16).Value = "Meas X"
    objNewBook.Sheets(1).Cells(1, 17).Value = "Meas Y"
    objNewBook.Sheets(1).Cells(1, 18).Value = "Meas Z"
    objNewBook.Sheets(1).Cells(1, 19).Value = "Bonus"
    objNewBook.Sheets(1).Cells(1, 20).Value = "Units"
    objNewBook.Sheets(1).Cells(1, 21).Value = "Standard"
    

    objNewBook.Sheets(1).Range("C2:S500").NumberFormat = "0.0000"
    objNewBook.Sheets(1).Columns.ColumnWidth = 10

  ' search pcDMIS For Dimension command
    iRowCount = 2
    For Each pcDMISCmd In pcDMISCmds
      ' ### Get Command Type ###################################################
        iType = -1
        If (pcDMISCmd.IsDimension) Then iType = 1
        If (pcDMISCmd.Type = FEATURE_CONTROL_FRAME) Then iType = 2
        If (pcDMISCmd.Type = ISO_TOLERANCE_COMMAND) Or (pcDMISCmd.Type = ASME_TOLERANCE_COMMAND) Then iType = 3
        If (pcDMISCmd.Type = ISO_SIZE_COMMAND) Or (pcDMISCmd.Type = ASME_SIZE_COMMAND) Then iType = 4
        If iType = -1 Then GoTo nextLoopIndex
      
      ' ### Select Type ###################################################
        Select Case iType
          Case 1 'Dimension
              If pcDMISCmd.Type = DATDEF_COMMAND Then GoTo nextLoopIndex
              If pcDMISCmd.GetText(ID, 0) <> "" Then
                If (pcDMISCmd.GetText(REF_ID, 2) <> pcDMISCmd.GetText(REF_ID, 1)) Then
                  sTemp = pcDMISCmd.GetText(ID, 0)
                  sTemp2 = pcDMISCmd.GetText(REF_ID, 1) + "; " + pcDMISCmd.GetText(REF_ID, 2)
                Else
                  sTemp = pcDMISCmd.GetText(ID, 0)
                  sTemp2 = pcDMISCmd.GetText(REF_ID, 0)
                End If
              End If

              If pcDMISCmd.Type = DIMENSION_START_LOCATION Then GoTo nextLoopIndex
              If pcDMISCmd.Type = DIMENSION_END_LOCATION Then GoTo nextLoopIndex
              If pcDMISCmd.Type = DIMENSION_START_LOCATION Then
                sTemp = pcDMISCmd.GetText(ID, 0)
                sTemp2 = pcDMISCmd.GetText(REF_ID, 0)
                GoTo nextLoopIndex
              End If
              
            ' Get DimensionCommand
              Set pcDMISDIMCmd = pcDMISCmd.DimensionCommand
          
            ' Write DimensionCommand data To Excel
              objNewBook.Sheets(1).Cells(iRowCount, 1).Value = sTemp 'ID
              objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp2 'ref-Feature ID
              objNewBook.Sheets(1).Cells(iRowCount, 3).Value = pcDMISDIMCmd.AxisLetter
              objNewBook.Sheets(1).Cells(iRowCount, 4).Value = pcDMISDIMCmd.Nominal
              objNewBook.Sheets(1).Cells(iRowCount, 5).Value = pcDMISDIMCmd.Measured
              objNewBook.Sheets(1).Cells(iRowCount, 6).Value = pcDMISDIMCmd.Plus
              objNewBook.Sheets(1).Cells(iRowCount, 7).Value = pcDMISDIMCmd.Minus
              objNewBook.Sheets(1).Cells(iRowCount, 8).Value = pcDMISDIMCmd.OutTol
              objNewBook.Sheets(1).Cells(iRowCount, 9).Value = pcDMISDIMCmd.Length
              objNewBook.Sheets(1).Cells(iRowCount, 10).Value = pcDMISDIMCmd.Deviation
              objNewBook.Sheets(1).Cells(iRowCount, 11).Value = pcDMISDIMCmd.Max
              objNewBook.Sheets(1).Cells(iRowCount, 12).Value = pcDMISDIMCmd.Min
              objNewBook.Sheets(1).Cells(iRowCount, 16).Value = pcDMISDIMCmd.Bonus
              If pcDMISDIMCmd.Units = 1 Then
                objNewBook.Sheets(1).Cells(iRowCount, 17).Value = "MM"
              Else
                objNewBook.Sheets(1).Cells(iRowCount, 17).Value = "INCH"
              End If
              objNewBook.Sheets(1).Cells(iRowCount, 18).Value = ""
              
            ' new Excel row
              iRowCount = iRowCount + 1
              
          Case 2 'FCF
            ' Write ExMeas-Command data To Excel
              iIndex = 1
              sTemp = pcDMISCmd.GetText(LINE2_FEATNAME, iIndex)
              Do While sTemp <> ""
            
                dMeas = pcDMISCmd.GetText(LINE2_MEAS, iIndex)
                dNominal = pcDMISCmd.GetText(LINE2_NOMINAL, iIndex)
                
               



                objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.ID
                objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp
                objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "FCF"  'AxisLetter
                objNewBook.Sheets(1).Cells(iRowCount, 4).Value = dNominal 'Nominal
                objNewBook.Sheets(1).Cells(iRowCount, 5).Value = dMeas 'Measured
                objNewBook.Sheets(1).Cells(iRowCount, 6).Value = pcDMISCmd.GetText(LINE2_PLUSTOL, iIndex)   'Plus
                objNewBook.Sheets(1).Cells(iRowCount, 7).Value = pcDMISCmd.GetText(LINE2_MINUSTOL, iIndex)  'Minus
                objNewBook.Sheets(1).Cells(iRowCount, 8).Value = pcDMISCmd.GetText(LINE2_OUTTOL, iIndex)  'OutTol
                objNewBook.Sheets(1).Cells(iRowCount, 9).Value = pcDMISCmd.GetText(MEAS_LENGTH, iIndex)   'Length
                objNewBook.Sheets(1).Cells(iRowCount, 10).Value = pcDMISCmd.GetText(LINE2_DEV, iIndex) 'Deviation
                objNewBook.Sheets(1).Cells(iRowCount, 11).Value = pcDMISCmd.GetText(LINE2_MAX, iIndex)'Max
                objNewBook.Sheets(1).Cells(iRowCount, 12).Value = pcDMISCmd.GetText(LINE2_MIN, iIndex) 'Min
                objNewBook.Sheets(1).Cells(iRowCount, 13).Value = pcDMISCmd.GetText(THEO_X, iIndex)  'Theoretical X VALUE
                objNewBook.Sheets(1).Cells(iRowCount, 14).Value = pcDMISCmd.GetText(THEO_Y, iIndex)  'Theoretical Y VALUE
                objNewBook.Sheets(1).Cells(iRowCount, 15).Value = pcDMISCmd.GetText(THEO_Z, iIndex)  'Theoretical Z VALUE                
                objNewBook.Sheets(1).Cells(iRowCount, 16).Value = pcDMISCmd.GetText(MEAS_X, iIndex)  'X VALUE                
                objNewBook.Sheets(1).Cells(iRowCount, 17).Value = pcDMISCmd.GetText(MEAS_Y, iIndex)  'Y VALUE                
                objNewBook.Sheets(1).Cells(iRowCount, 18).Value = pcDMISCmd.GetText(MEAS_Z, iIndex)  'Z VALUE
                objNewBook.Sheets(1).Cells(iRowCount, 19).Value = pcDMISCmd.GetText(LINE2_BONUS, iIndex)  'Bonus
                objNewBook.Sheets(1).Cells(iRowCount, 20).Value = pcDMISCmd.GetText(UNIT_TYPE, 0)  'Units
                objNewBook.Sheets(1).Cells(iRowCount, 21).Value = pcDMISCmd.GetText(STANDARD, 0)
                
                
          
              ' new GeoTol Row
                iIndex = iIndex + 1
                sTemp = pcDMISCmd.GetText(LINE2_FEATNAME, iIndex)
                
              ' new Excel row
                iRowCount = iRowCount + 1
              Loop
              
          Case 3 'GEO
            ' Write GeoTol-Command data To Excel
              iIndex = 1
              sTemp = pcDMISCmd.GetText(REF_ID, iIndex)
              Do While sTemp <> ""
                objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.ID
                objNewBook.Sheets(1).Cells(iRowCount, 2).Value = sTemp
                objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "GEO"  'AxisLetter
          
                dTol = pcDMISCmd.GetText(FORM_TOLERANCE, 1)
                dMeas = pcDMISCmd.GetTextEx(DIM_DEVIATION, iIndex, "SEG=1")

                objNewBook.Sheets(1).Cells(iRowCount, 4).Value = 0    'Nominal
                objNewBook.Sheets(1).Cells(iRowCount, 5).Value = dMeas  'Measured
                objNewBook.Sheets(1).Cells(iRowCount, 6).Value = dTol   'Plus
                objNewBook.Sheets(1).Cells(iRowCount, 7).Value = 0  'Minus
                If dMeas > dTol Then
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = dTol - dMeas  'OutTol
                Else
                  objNewBook.Sheets(1).Cells(iRowCount, 8).Value = 0  'OutTol
                End If
                objNewBook.Sheets(1).Cells(iRowCount, 9).Value = 0   'Length
                objNewBook.Sheets(1).Cells(iRowCount, 10).Value = dMeas  'Deviation
                objNewBook.Sheets(1).Cells(iRowCount, 11).Value = 0  'Max
                objNewBook.Sheets(1).Cells(iRowCount, 12).Value = 0  'Min
                objNewBook.Sheets(1).Cells(iRowCount, 13).Value = pcDMISCmd.GetTextEx(MEAS_X, iIndex, "SEG=1")  'X VALUE
	            objNewBook.Sheets(1).Cells(iRowCount, 14).Value = pcDMISCmd.GetTextEx(MEAS_Y, iIndex, "SEG=1")  'Y VALUE
                objNewBook.Sheets(1).Cells(iRowCount, 15).Value = pcDMISCmd.GetTextEx(MEAS_Y, iIndex, "SEG=1")  'Z VALUE
                objNewBook.Sheets(1).Cells(iRowCount, 16).Value = pcDMISCmd.GetTextEx(DIM_BONUS, iIndex, "SEG=1")  'Bonus
                objNewBook.Sheets(1).Cells(iRowCount, 17).Value = pcDMISCmd.GetText(UNIT_TYPE, 0)   'Units
                objNewBook.Sheets(1).Cells(iRowCount, 18).Value = pcDMISCmd.GetText(STANDARD, 0)   'STANDARD
          
              ' new GeoTol Row
                iIndex = iIndex + 1
                sTemp = pcDMISCmd.GetText(REF_ID, iIndex)
                
              ' new Excel row
                iRowCount = iRowCount + 1
              Loop
              
          Case 4 'Size
            ' Write ToleranceCommand data To Excel
              objNewBook.Sheets(1).Cells(iRowCount, 1).Value = pcDMISCmd.GetText(ID, 0)
              objNewBook.Sheets(1).Cells(iRowCount, 2).Value = pcDMISCmd.GetText(REF_ID, 0)
              objNewBook.Sheets(1).Cells(iRowCount, 3).Value = "SIZE"          
              objNewBook.Sheets(1).Cells(iRowCount, 4).Value = pcDMISCmd.GetText(Nominal, 0)   'Nominal
              objNewBook.Sheets(1).Cells(iRowCount, 5).Value = CDbl(pcDMISCmd.GetText(Nominal, 0)) + CDbl(pcDMISCmd.GetText(DIM_DEVIATION, 0)) 'Measured
              objNewBook.Sheets(1).Cells(iRowCount, 6).Value = pcDMISCmd.GetText(UPPER_TOLERANCE, 0)   'Plus
              objNewBook.Sheets(1).Cells(iRowCount, 7).Value = pcDMISCmd.GetText(LOWER_TOLERANCE, 0)  'Minus
              objNewBook.Sheets(1).Cells(iRowCount, 8).Value = 0    'OutTol
              objNewBook.Sheets(1).Cells(iRowCount, 9).Value = 0   'Length
              objNewBook.Sheets(1).Cells(iRowCount, 10).Value = pcDMISCmd.GetText(DIM_DEVIATION, 0)  'Deviation
              objNewBook.Sheets(1).Cells(iRowCount, 11).Value = 0  'Max
              objNewBook.Sheets(1).Cells(iRowCount, 12).Value = 0  'Min
              objNewBook.Sheets(1).Cells(iRowCount, 16).Value = 0  'Bonus
              objNewBook.Sheets(1).Cells(iRowCount, 17).Value = pcDMISCmd.GetText(UNIT_TYPE, 0) 'Units
              objNewBook.Sheets(1).Cells(iRowCount, 18).Value = pcDMISCmd.GetText(STANDARD, 0)
          
            ' new Excel row
              iRowCount = iRowCount + 1
              
        End Select
      
nextLoopIndex:
    Next pcDMISCmd
    
    

    
  ' Close excel
    objExcel.ScreenUpdating = True
    objExcel.Visible = True
    sPath = "C:\CMM\TEST.XLSX"
    'objNewBook.SaveAs sPath
    'objExcel.Quit

  ' unDim Something
    Set objNewBook = Nothing
    Set objExcel = Nothing
    Set pcDMISCmd = Nothing
    Set pcDMISCmds = Nothing
    Set pcDMISPart = Nothing
    Set pcDMISApp = Nothing
End Sub