该脚本能够输出FCF数据;然而,作为一名质量控制专业人员,我不熟悉如何修改其代码以确保其输出完整的内容,包括位置公差、轮廓公差和XY信息。帮助。
谢谢。
Your Products have been synced, click here to refresh
该脚本能够输出FCF数据;然而,作为一名质量控制专业人员,我不熟悉如何修改其代码以确保其输出完整的内容,包括位置公差、轮廓公差和XY信息。帮助。
谢谢。
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
thanks.
© 2024 Hexagon AB and/or its subsidiaries. | Privacy Policy | Cloud Services Agreement |