2.Problem:IF true position is existed,other Axis deviation needs to be removed;
Public Function GetAxis(t As OBTYPE) As String Dim s As String Select Case t Case DIMENSION_D_LOCATION: s = "D" Case DIMENSION_A_LOCATION: s = "A" Case DIMENSION_H_LOCATION: s = "H" Case DIMENSION_L_LOCATION: s = "L" Case DIMENSION_PA_LOCATION: s = "PA" Case DIMENSION_PD_LOCATION: s = "PD" Case DIMENSION_PR_LOCATION: s = "PR" Case DIMENSION_R_LOCATION: s = "R" Case DIMENSION_RS_LOCATION: s = "RS" Case DIMENSION_RT_LOCATION: s = "RT" Case DIMENSION_S_LOCATION: s = "S" Case DIMENSION_T_LOCATION: s = "T" Case DIMENSION_V_LOCATION: s = "V" Case DIMENSION_X_LOCATION: s = "X" Case DIMENSION_Y_LOCATION: s = "Y" Case DIMENSION_Z_LOCATION: s = "Z" Case DIMENSION_TRUE_DD_LOCATION: s = "DD" Case DIMENSION_TRUE_DF_LOCATION: s = "DF" Case DIMENSION_TRUE_DIAM_LOCATION: s = "TP" Case DIMENSION_TRUE_D1_LOCATION: s = "D1" Case DIMENSION_TRUE_D2_LOCATION: s = "D2" Case DIMENSION_TRUE_D3_LOCATION: s = "D3" Case DIMENSION_TRUE_PA_LOCATION: s = "PA" Case DIMENSION_TRUE_PR_LOCATION: s = "PR" Case DIMENSION_TRUE_X_LOCATION: s = "X" Case DIMENSION_TRUE_Y_LOCATION: s = "Y" Case DIMENSION_TRUE_Z_LOCATION: s = "Z" Case Else: s = "M" End Select GetAxis = s End Function Sub Main() 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 Command Dim exlapp As Object Dim wbook As Object Dim sht As Object Dim str i = 2 Set exlapp = CreateObject("excel.application") Set wbook = exlapp.Workbooks.Add Set sht = wbook.Sheets(1) sht.Range("A"&1)="ID":sht.Range("B"&1)="Nominal":s ht.Range("C"&1)="+Tol" sht.Range("D"&1)="-Tol":sht.Range("E"&1)="Measured":sht.Range("F"&1)= "Dev":sht.Range("G"&1)="Out" For Each Cmd In Cmds If Cmd.IsDimension Then If Cmd.ID <> "" Then str = Cmd.ID Select Case Cmd.Type Case 1002, 1003, 1004, 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, 1015, 1016, 1017 sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type) sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0) sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0) sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0) sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0) sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0) sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0) i = i + 1 Case 1202, 1203, 1204, 1205, 1206, 1207, 1208,1214,1215,1216 sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type) sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0) sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0) sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0) sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0) sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0) sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0) i = i + 1 Case 1209 sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type) sht.Range("B" & i) = 0 sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0) sht.Range("D" & i) = 0 sht.Range("E" & i) = Cmd.GetText(DIM_DEVIATION, 0) sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0) sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0) i = i + 1 Case 1100, 1101, 1102, 1103, 1104, 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, 1115, 1116, 1117, 1118 sht.Range("A" & i) = str & "-" & GetAxis(Cmd.Type) sht.Range("B" & i) = Cmd.GetText(NOMINAL, 0) If sht.Range("B" & i) = "" Then sht.Range("B" & i)=0 sht.Range("C" & i) = Cmd.GetText(F_PLUS_TOL, 0) sht.Range("D" & i) = Cmd.GetText(F_MINUS_TOL, 0) If sht.Range("D" & i) = "" Then sht.Range("D" & i)=0 sht.Range("E" & i) = Cmd.GetText(DIM_MEASURED, 0) sht.Range("F" & i) = Cmd.GetText(DIM_DEVIATION, 0) sht.Range("G" & i) = Cmd.GetText(DIM_OUTTOL, 0) i = i + 1 End Select End If Next exlapp.Visible = True exlapp.DisplayAlerts = False Set exlapp = Nothing Set wbook = Nothing Set sht = Nothing End Sub