hexagon logo
Register Sign in
  • Replies 10 replies
  • Subscribers 31 subscribers
  • Views 151 views
  • Users 0 members are here
Options
Related

Sript error Line38

Bitola
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 
  • 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
  • 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.
  • 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 ?
  • 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?
  • 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

  • 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?)
  • 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!!
  • Ninja Badger, that fixed the problem. Thanks again!
    Here is the fixed updated code if somebody needs it 
    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
  • 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.
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement