Need help on OUTTOL.BAS file

I have used this script many time and have even made a couple minor mods.
Here is my issue. It is looking for "END OF DIMENSION" and profiles and distances do not have this. It skips over and ignore those. Anybody have an idea as to how I can mod this script to do this ???

Time is critical, I appreciate anyone who responds and helps !!

For Each Cmd In Cmds
    ' if the command of the current iteration is a dimension ...
    If Cmd.IsDimension Then
      ' and it is not a start or end dimension object ...
      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
        ' then get the dimensioncommand object from the command
        Set DimCmd = Cmd.DimensionCommand
        ' If it is out of tolerance, increment numberout, otherwise increment numberin
        If DimCmd.OutTol > 0 Then
          NumberOut = NumberOut + 1
        Else

jjewell over 15 years ago

I'm not sure that there is a seperate profile axis. I think that it is covered under location axis. But then again the version that I wrote this for (3.7) doesn't have all of that funky XactMeasure stuff either. Is this not picking up your profiles?

I had that issue initially and changed it back to legacy dims, we are using 2009 version with this right now. I tried TP, thats picks it up fine, but what about keyed in, or profiles. It seems to be ignoring them altogether...not sure what to try and add now...hmmmm
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
Chally72 over 15 years ago

Try changing the code I just posted for your purposes and using the entire chunk. Jan's method is pretty solid, and works for Xact measure and Legacy dimensions very well. I was fooling around with craiger's original OUTTOL.BAS for a long time, and finally grabbed jan's because I had basically rewritten it to look like his anyways.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
EHines over 15 years ago

I had that issue initially and changed it back to legacy dims, we are using 2009 version with this right now. I tried TP, thats picks it up fine, but what about keyed in, or profiles. It seems to be ignoring them altogether...not sure what to try and add now...hmmmm

I don't have 2k9 so I'm not sure what the heck may have changed. The place that I got the info for the IsLocationAxis/IsTurePosAxis info was under the properties of the DimensionCommand Object in the help file. Maybe in there it will have more of these types of properties listed if there are any.

It does seem to get profiles and keyins ok for me.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
jjewell over 15 years ago

Try changing the code I just posted for your purposes and using the entire chunk. Jan's method is pretty solid, and works for Xact measure and Legacy dimensions very well. I was fooling around with craiger's original OUTTOL.BAS for a long time, and finally grabbed jan's because I had basically rewritten it to look like his anyways.

It does look good, but I need a message box, not a file. I amy try and fix that..

Tnx
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

Chally72 over 15 years ago

This already throws up a messagebox in the code:

If dblouttol > 0 Then 
  [COLOR="Red"][U] 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[/U][/COLOR]   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.

jjewell over 15 years ago

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.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
Chally72 over 15 years ago

....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.
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
jjewell over 15 years ago

Hey ! Thanks for trying ! Where the heck is Craiger when you need him !!
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

Chally72 over 15 years ago

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

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

jjewell over 15 years ago

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...
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel