Outtol script syntax error on line161 End Sub

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

  • Outtol script syntax error on line161 End Sub

    Hello,
    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!
    https://www.pcdmisforum.com/filedata/fetch?type=thumb&filedataid=19855
    HTML Code:
    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

  • #2
    You are missing Sub Main() at the start and End Sub at the end?

    EDIT: Only Sub Main() is missing.
    Last edited by vpt.se; 01-08-2021, 03:03 AM.
    PC-DMIS CAD++ 2o19 R1 SP11

    Comment


    • #3
      vpt.se, thank you so much! When I copied Ctrl+A for some reason didn't highlight Sub Main(). I greatly appreciate it, Thank you again!!

      Comment


      • #4
        No worries, glad to have helped!
        PC-DMIS CAD++ 2o19 R1 SP11

        Comment

        Related Topics

        Collapse

        Working...
        X