Same Outtol script that works on 3 CMM's it doesn't work on this. Gives me this error message. Anyone know what could cause that? Any input is greatly appreciated. Thank you!
Dim objApp As Object Set objApp = CreateObject("PCDLRN.Application") Dim objPart As Object Set objPart = objApp.ActivePartProgram Dim objCmds 'As Object Set objCmds = objPart.Commands Dim objCmd 'As Object Dim objDimCmd As Object Dim dblOutTol As Long dblOutTol = 0 Dim dblTotalMeas As Long dblTotalMeas = 0 'Open newdir & "\DIMENSIONSEVALUATED.TXT" For Output As #3 Dim prevID1Name As String Dim count1 Dim count2 Dim prevcount1 Dim prevcount2 Dim prevID2Name As String Dim objCmdDeviation As Double Dim objCmdOuttol As Double Dim ID1 As String Dim ID2 As String Dim DimensionName As String Dim Msg As String Dim cnt As Integer For cnt =1 To Objcmds.count Set objcmd = objcmds.Item(cnt) If objcmd.marked = True Then 'CHECK For MARKED DIMENSIONS HERE If objcmd.IsDimension Then Set Dimensionname = objcmd.DimensionCommand ID1 = Dimensionname.feat1 'capture the ID Name of the command that is being looked at. count1 = cnt If ID1 = "" Then 'Make sure that commands always have a Name. ID1 = prevID1Name count1 = prevcount1 End If prevID1Name = ID1 'Save the old Name just In Case the Next one is "" prevcount1 = count1 ID2 = Dimensionname.feat2 count2 = cnt If ID2 = "" Then ID2 = prevID2Name count2 = prevcount2 End If PrevID2Name = ID2 prevcount2 = count2 If count1 = count2 Then 'If .feat1 And .feat2 names were found On the same Line, Then assign them both To the ID thats outtol ID1 = ID1 & "-" & ID2 End If End If 'Second Step: first possibility: hunt For legacy dimensions If objCmd.IsDimension And objCmd.Type<>1000 Then dblTotalMeas=dblTotalMeas+1 Set objDimCmd=objCmd.DimensionCommand If objDimCmd.OutTol<>0 Then dblOutTol=dblOutTol+1 Msg = Msg & ID1 & Chr(10) End If 'objDimCmd.OutTol<>0 'Print #3, "***LEGACY***" & ID1 & "***" 'Print #3, "objCmd.Type: " & objcmd.Type 'Print #3, "OUTTOL number: " & objDimCmd.OutTol 'Print #3, "Number out of tolerance: " & dblOutTol 'Print #3, "Total evaluated: " & dblTotalMeas 'Print #3, "" End If 'objCmd.IsDimension 'Third Step: second possibility: hunt For XactMeasure GD&T dimensions If objCmd.Type=184 Then 'this seems To be the way To find an XactMeasure GD&T Call. If objCmd.gettext(LINE1_OUTTOL,1)<>"" Then 'look In Line 1 For an OUTTOL dblTotalMeas=dblTotalMeas+1 If objCmd.gettext(LINE1_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 1, is it Not zero? dblOutTol=dblOutTol+1 Msg = Msg & ID1 & Chr(10) End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0 'Print #3, "***XactMeasure Line1***" & ID1 & "***" 'Print #3, "OUTTOL number: " & objCmd.gettext(LINE1_OUTTOL,1) 'Print #3, "Number out of tolerance: " & dblOutTol 'Print #3, "Total evaluated: " & dblTotalMeas 'Print #3, "" End If 'objCmd.gettext(LINE1_OUTTOL,1)<>"" If objCmd.gettext(LINE2_OUTTOL,1)<>"" Then 'look In Line 2 For an OUTTOL dblTotalMeas=dblTotalMeas+1 If objCmd.gettext(LINE2_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 2, is it Not zero? dblOutTol=dblOutTol+1 Msg = Msg & ID1 & Chr(10) End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0 'Print #3, "***XactMeasure Line2***" & ID1 & "***" 'Print #3, "OUTTOL number: " & objCmd.gettext(LINE2_OUTTOL,1) 'Print #3, "Number out of tolerance: " & dblOutTol 'Print #3, "Total evaluated: " & dblTotalMeas 'Print #3, "" End If 'objCmd.gettext(LINE2_OUTTOL,1)<>"" If objCmd.gettext(LINE3_OUTTOL,1)<>"" Then 'look In Line 3 For an OUTTOL dblTotalMeas=dblTotalMeas+1 If objCmd.gettext(LINE3_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 3, is it Not zero? dblOutTol=dblOutTol+1 Msg = Msg & ID1 & Chr(10) 'End If 'objCmd.gettext(LINE3_OUTTOL,1)<>0 'Print #3, "***XactMeasure Line3***" & ID1 & "***" 'Print #3, "OUTTOL number: " & objCmd.gettext(LINE3_OUTTOL,1) 'Print #3, "Number out of tolerance: " & dblOutTol 'Print #3, "Total evaluated: " & dblTotalMeas 'Print #3, "" End If 'objCmd.gettext(LINE3_OUTTOL,1)<>"" End If 'objCmd.Type=184 End If 'objcmd.marked = True 'End marked search here End If Next cnt 'Close #3 Dim Var Dim Var2 As Object If dblouttol = 0 Then msgbox "Part is GOOD!" Set Var = objPART.GetVariableValue ("SUB_OUTTOLNUM") 'Grabs the variable SUB_OUTTOLNUM from the subroutine program Var.stringvalue = dblouttol 'Sets variable As number of outtol dimensions. Change this To actual CMM Name/number Set Var2 = objPART.getvariablevalue ("SUB_ACCEPTREJECT") 'Grabs the variable Sub_ACCEPTREJECT from the subroutine program var2.stringvalue = "~~1 ACCEPTED" 'Sets variable As Accept, As part is good End If If dblouttol > 0 Then MsgBox "Part is BAD!" & Chr(10) & "Number of Dimensions Out of Tolerance:" & dblouttol & Chr(10) &"Features out of tolerance:" & Chr(10) & Msg ' Display the ID's that are out of tolerance Set Var = objPART.GetVariableValue ("SUB_OUTTOLNUM") 'Grabs the variable SUB_OUTTOLNUM from the subroutine program Var.stringvalue = dblOutTol 'Sets variable As number of outtol dimensions. Change this To actual CMM Name/number Set Var2 = objPART.getvariablevalue ("SUB_ACCEPTREJECT") 'Grabs the variable Sub_ACCEPTREJECT from the subroutine program var2.stringvalue = "~~4 REJECTED" 'Sets variable As Accept, As part is good End If objPART.SetVariableValue "SUB_OUTTOLNUM", Var 'Passes the number of outtol dimensions back To the subroutine objPART.SetVariableValue "SUB_ACCEPTREJECT", Var2 End Sub