Sript error Line38

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

  • Sript error Line38

    Hello all,
    I've been using script out of tol for a while. It worked fine on verisons 2010,2013,2018 but as soon as I updated to 2019R2 script is giving me Line 38 error on Off line. Same program ran on machines with PCDMIS 2013MR1, works with out problem. I reported the issue with Hexagon but no help yet. I wonder if someone could help me with this. I will greatly appreciate it. Attached is the script and error messages. Thank you!!
    Attached Files

  • #2
    Can you post the code for the script?

    Comment


    • #3
      Code:
      Sub Main()
      
      'This *.bas is a simple, modified version of CraigerNY's modified outtol.bas (whose original author nobody seems To know).
      ' Contributors: CraigerNY, Jan D., Chally72, N3WPV, VPT.SE
      '
      'Modified 9/23/09 DGG To include feature ID In the outtol comment. 
      '  Works With anything up To 2 features, including reference features. 
      '  TP callouts using more than 2 features will Not show reference datums beyond the first one. 
      '
      'Modified To include Xactmeasure dimensions
      'Modified To pass # of out-of-tol dims To PCDMIS To fill In required variable NUMBEROUTTOL
      
      
      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
      Dim objOutTol As Object
      Set objOutTol = objPart.GetVariableValue("NUMBEROUTTOL")               'number of outtols found
      
      
      Dim prevIDName As String
      Dim count1
      Dim count2
      Dim prevcount1
      Dim prevcount2
      Dim prevID2Name As String
      Dim objCmdDeviation As Double
      Dim objCmdOuttol As Double
      Dim ID 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
              ID = DimensionName.feat1          'capture the ID Name of the command that is being looked at.
              count1 = cnt
              If ID = "" Then            'Make sure that commands always have a Name.
                   ID = prevIDName
                   count1 = prevcount1
              End If
              prevIDName = ID       '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
                 ID = ID & "-" & 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 & ID & Chr(10)
                  End If 'objDimCmd.OutTol<>0
              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.
      
                  ID = objCmd.ID
      
                  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 & ID & Chr(10)
                      End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0
                  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 & ID & Chr(10)
                      End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0
                  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 & ID & Chr(10)
                      End If 'objCmd.gettext(LINE3_OUTTOL,1)<>0
                  End If 'objCmd.gettext(LINE3_OUTTOL,1)<>""
      
              End If 'objCmd.Type=184
      
           End If    'objcmd.marked = True        'End marked search here
      
      
      Next cnt
      
      
      If dblOutTol = 0 Then
         MsgBox "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
      End If
      
      
      Set objOutTol.DoubleValue=dblOutTol
      objPart.SetVariableValue "NUMBEROUTTOL",objOutTol 
      
      
      
      End Sub

      Comment


      • #4
        Same program and Script works fine on :Windows10 with only 1 PCDMIS version installed - 2018R2,
        Windows7 with multiple versions installed, but current version is 2013mr1
        Now I like to update all CMM's to Windows10 with PCDMIS2019R2 but I am afraid if code would stop working.

        Comment


        • #5
          I'm using 2019 R1 and it works with windows 7 & 10. I didn't see anything wrong with the script from my end

          Are you using the same PCDMIS program to test the script in 2013,2018, and 2019 ?

          Comment


          • #6
            It's the same script for all the versions and I am using exactly the same program. So I was running 2018r2 on offline it worked fine. Then I updated to 2019r1 and then when I started getting the error. Then I updated to 2019R2 and got the same error. Then I uninstalled 2018 and 2019 and re insall 2019r2 back and I am still getting same error. Do you have only one version of PCDMIS installed on your PC just 2019R1 or have older versions also?

            Comment


            • #7
              I only have 2019 R1 installed. I put all my old versions on a backup flash drive. I offline program with the same setup as my online computer (windows 10, 2019 R1) so I don't have compatibility issues

              Comment


              • #8

                There was one recently where some Pc-Dmis reserved words which previously worked in scripts now didn't.

                Change
                Dim ID As String to Dim ID1 as string
                ...and also every other instance where ID is used (Be careful if you try use Find & Replace and it may change all the ID2's as well.)

                (Does that make sense?)
                Automettech - Automated Metrology Technology

                Comment


                • #9
                  I did change ID As String to ID1 As String but only on Line 38 and didn't work. I will try to change all the blank ID's to ID1 and I will let you know. Thanks to both of you for the reply!!

                  Comment


                  • #10
                    Ninja Badger, that fixed the problem. Thanks again!
                    Here is the fixed updated code if somebody needs it
                    Code:
                     Sub Main()
                    
                    'This *.bas is a simple, modified version of CraigerNY's modified outtol.bas (whose original author nobody seems To know).
                    ' Contributors: CraigerNY, Jan D., Chally72, N3WPV, VPT.SE
                    '
                    'Modified 9/23/09 DGG To include feature ID In the outtol comment. 
                    '  Works With anything up To 2 features, including reference features. 
                    '  TP callouts using more than 2 features will Not show reference datums beyond the first one. 
                    '
                    'Modified To include Xactmeasure dimensions
                    'Modified To pass # of out-of-tol dims To PCDMIS To fill In required variable NUMBEROUTTOL
                    
                    
                    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
                    Dim objOutTol As Object
                    Set objOutTol = objPart.GetVariableValue("NUMBEROUTTOL")               'number of outtols found
                    
                    
                    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 ID1 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 ID1 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
                            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.
                    
                                ID1 = objCmd.ID1
                    
                                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
                                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
                                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
                                End If 'objCmd.gettext(LINE3_OUTTOL,1)<>""
                    
                            End If 'objCmd.Type=184
                    
                         End If    'objcmd.marked = True        'End marked search here
                    
                    
                    Next cnt
                    
                    
                    If dblOutTol = 0 Then
                       MsgBox "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 ID1's that are out of tolerance
                    End If
                    
                    
                    Set objOutTol.DoubleValue=dblOutTol
                    objPart.SetVariableValue "NUMBEROUTTOL",objOutTol 
                    
                    
                    
                    End Sub

                    Comment


                    • #11
                      I just noticed that I made typo error on the name of the post. Is there any way I can fix that, or that is not editable.

                      Comment

                      Related Topics

                      Collapse

                      Working...
                      X