Need help on OUTTOL.BAS file

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

  • #16
    This already throws up a messagebox in the code:

    Code:
    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
    Not only does it give you number outtol, it gives you the feature it was outtol on. The set variable lines are to put those outtol numbers into variables in my program. You can just put a ' in front of them.

    The code that makes a debug text file that Jan had has just been changed to comments, so it will not execute. There is no export to file anything.
    Last edited by Chally72; 09-28-2009, 04:03 PM.

    Comment


    • #17
      Ok, I was wondering how I could use Ehines code, but get it to look for "M" axis...

      Jans is a little heavy for me and I am trying to edit and use it with 3.7 at the moment.
      Jim Jewell

      Comment


      • #18
        ....These are tough, it was trial and error for me to get anywhere when I started modifying Craiger's code. I'm sorry, I can't help with your existing code.

        Comment


        • #19
          Hey ! Thanks for trying ! Where the heck is Craiger when you need him !!
          Jim Jewell

          Comment


          • #20
            Try this: Should be paste and play. I've taken out everything you don't need.

            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
            
            
            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.
            
                        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!"  
                                                                                  '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                                                                  'Sets variable As Accept, As part is good
                      
            End If  
            
            End Sub

            Comment


            • #21
              errors...did you try and run it as posted ? When I compiled it I got
              lots of errors. Tried to adjust on my own, now I am lost...
              Jim Jewell

              Comment


              • #22
                The code is missing a subroutine start.

                sub Main()
                PC-DMIS CAD++ 2o18 R2 SP3

                Comment


                • #23
                  Doh!

                  Whoops, guys. Sorry Jim. I sent you a new script file anyways that is a bit cleaner. Check your email.

                  Comment


                  • #24
                    Here's the changed bit of code I sent Jim this morning. He substituted it for his and says it works fine with no changes.

                    Code:
                    Sub Main()
                    
                    'This *.bas is a simple, modified version of Craigs modified outtol.bas (whose original author nobody seems To know).
                    'Jan.
                    '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. 
                    
                    
                    Dim objApp As Object
                    Set objApp = CreateObject("PCDLRN.Application")
                    Dim objPart As Object
                    Set objPart = objApp.ActivePartProgram
                    Dim objCmds
                    Set objCmds = objPart.Commands
                    Dim objCmd
                    Dim objDimCmd As Object
                    Dim dblOutTol As Long
                    dblOutTol = 0
                    Dim dblTotalMeas As Long
                    dblTotalMeas = 0
                    
                    
                    
                    
                    
                    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.
                    
                                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
                    
                    
                    End Sub

                    Comment


                    • #25
                      Taken from N3WPV's thread, all I did was add more credit and revision history:
                      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


                      • #26
                        Josh, You have just made me a happy man!
                        Your code works perfectly for me.

                        One wish is still open for me.
                        How do I get the content of Msg to my program?

                        I have no problem with the NUMEROUTTOL, but how do I "tell" the script to transfer the Msg variable?


                        Regards
                        Best regards

                        Michael
                        -- o --
                        DEA Global - 09-15-08
                        Renishaw PH10MQ w/ TP200 & SCR200-Rack
                        PC-DMIS CAD Ver. 2017 R2 / PC-DMIS 2011 MR1

                        Comment


                        • #27
                          Hello,
                          I am trying execute script, script should work if type output of dimension are "BOTH" or "REPORT".

                          This don't work:
                          If ReportDim = "BOTH" Or ReportDim = "REPORT" Then

                          This also don't work:
                          [CheckDim = Cmd.GetText (3 , OUTPUT_TYPE, 0)
                          If CheckDim <> "" Then
                          ReportDim = CheckDim
                          End If
                          If ReportDim = "BOTH" Or ReportDim = "REPORT" Then]

                          As per picture, Dim.No.122 and Dim.No.126 should be shoved and Dim.No.126 should be shoved only once.

                          How I should proper add conditions of "BOTH" and "REPORT" ?

                          Regards
                          Attached Files

                          Comment


                          • #28
                            Unfortunately the structure of this quite old script doesn't lend itself to that modification. Many legacy dimensions have a structure containing multiple commands (DIMENSION_START, axis1, axis2, … , axisN, DIMENSION_END), and the OutputMode flag (and dimension ID) is only available on the DIMENSION_START command, so the obvious mod,

                            Code:
                            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 objDimCmd = objCmd.DimensionCommand
                                    If (objDimCmd.OutputMode = DIMOUTPUT_NONE) Or (objDimCmd.OutputMode = DIMOUTPUT_STATS) Then
                                      GoTo NextCommand
                                    End If
                            
                                   <the rest of the code>
                            
                            NextCommand:
                            Next cnt
                            doesn't work. The script would have to be rewritten to detect the DIMENSION_START, save the OutputMode, and be in state "in a multi line dimension" until DIMENSION_END. I don't have the time for that, but maybe someone else feel adventurous...
                            AndersI
                            SW support - Hexagon Metrology Nordic AB

                            Comment


                            • Darius11
                              Darius11 commented
                              Editing a comment
                              Andersl,

                              Thanks for bit of info. I have script which exporting data to excel and I'm thinking that structure should be similar. That script depends on type of commands, if yes then I should use :
                              If Cmd.Type <> 1299 then
                              If Cmd.Type = 1118 then
                              if Cmd.Type = 1105 then
                              If Cmd.Type = 184 then

                              Next step:

                              If Cmd.IsDimension Then
                              If Cmd.Type = DIMENSION_START_LOCATION Or/and Cmd.Type = DIMENSION_TRUE_START_POSITION Then

                              If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
                              Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then


                              If I do understand well COMMQAND.Type should ensure that script will not miss any type of countable dimension and DIMENSION_START/DIMENSION_END will describe where script should look for "OUT OF TOLERANCE". Am I right?

                          • #29
                            Pseudocode (may contain traces of error…)

                            Code:
                            If the command is DIMENSION_START then
                                    extract OutputMode and ID, nothing else.
                                    set boolean flag InStructuredDimension=True
                            
                            else if the command is DIMENSION_END then
                                    set OutputMode to none and ID to "".
                                    set boolean flag InStructuredDimension=False
                            
                            else if the command is some other dimensioncommand
                                    if InStructuredDimensione==True then
                                          extract everything except OutputMode and ID from the command
                                    else
                                          extract everything from the command
                                    endif
                                    produce your output
                            else
                                    if InStructuredDimension==True then
                                            structure error (dimension_end missing??)
                                            set OutputMode to none and ID to "".
                                            set boolean flag InStructuredDimension=False
                                    endif
                            endif
                            AndersI
                            SW support - Hexagon Metrology Nordic AB

                            Comment

                            Related Topics

                            Collapse

                            Working...
                            X