Counting OUTTOL in a program

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

  • Counting OUTTOL in a program

    NOTE: There's a much better solution here: http://www.pcdmisforum.com/showthrea...l=1#post401750

    Forget this...

    This is my script for counting the number of OUTTOL in a program, for use on older versions of PC-DMIS that don't have GETPROGRAMINFO(...).
    (Sorry for Swedish, but I think you can understand it)

    Code:
    '--------------------------------------------------------------------
    ' Count all dimensions out of tolerance
    ' Set the indicated PCDMIS variable to the number
    '
    ' Usage:
    '
    '            TILLDELA/OT=0
    'CS1        =SKRIPT/FILNAMN= C:\DOCUMENTS AND SETTINGS\ALL USERS\DOKUMENT\WAI\PC-DMIS\2010 MR2\COUNTOUTOFTOL.BAS
    '            FUNKTION/CountOutOfTol,VISA=JA,ARG1="OT",,
    '            BÖRJA_SKRIPT/
    '            SLUTA_SKRIPT/
    '
    '            KOMMENTAR/OPERATÖR,NEJ,HELSKÄRM=NEJ,FORTSÄTT AUTOMATISKT=NEJ,
    '            Antal utvärderingar utom tolerans
    '            OT
    '
    '--------------------------------------------------------------------
    
    Sub CountOutOfTol(OutTolVar As String)
    
    Dim App As Object
    Set App = CreateObject("PCDLRN.Application")
    Dim Part As Object
    Set Part = App.ActivePartProgram
    Dim Cmds As Object
    Set Cmds = Part.Commands
    Dim Cmd As Object
    Dim DCmd As Object
    Dim FCFOT As String
    Dim I As Integer
    
    Dim OutTolValue As Object
    Set OutTolValue = Part.GetVariableValue(OutTolVar)
    
    If Not OutTolValue is Nothing Then
    
      OutTolValue.LongValue = 0
    
      For Each Cmd In Cmds
    
        If Cmd.IsDimension 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
            Set DCmd = Cmd.DimensionCommand
            if (DCmd.OutTol <> 0) then
              OutTolValue.LongValue = OutTolValue.LongValue + 1
            End If
          End If
        ElseIf Cmd.Type = 184 Then ' FCF
          I = 1
          FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
          While (Not OutOfTol) And (FCFOT <> "")
            If Val(FCFOT) <> 0 Then
              OutTolValue.LongValue = OutTolValue.LongValue + 1
            End If
            I = I + 1
            FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
          Wend
        End If
      Next Cmd
    
      If Not OutTolValue is Nothing Then
        Part.SetVariableValue OutTolVar, OutTolValue
      End If
    
    Else
       MsgBox "Variabeln " + OutTolVar + " saknas i PCDMIS-programmet!"
    End If
    
    End Sub
    
    Sub Main
    End Sub
    Last edited by AndersI; 08-17-2015, 09:01 AM.
    AndersI
    SW support - Hexagon Metrology Nordic AB

  • #2
    AndersI - That is very close to my VB script for getting the Deviation values for all features to dump into a CSV file or to SQL. Didn't know the Name to go after or the value of 184... Nice !!!
    Last edited by SunfireSSR; 06-01-2015, 08:01 AM.

    Comment


    • #3
      Originally posted by SunfireSSR View Post
      Didn't know the Name to go after or the value of 184... Nice !!!
      I hope it works for you! Btw. the value 184 should really be FEATURE_CONTROL_FRAME instead. You can find all these values (and names) by exploring the Type Library (pcdlrn.tlb) that is imported in Excel (or any other development tool) and applying a bit of imagination...
      AndersI
      SW support - Hexagon Metrology Nordic AB

      Comment


      • #4
        What is ---> FUNKTION/CountOutOfTol,VISA=JA,ARG1="OT",,

        Cannot get Script to read value(OutTolVAR) from PC-Dmis though. Did try changing to OUTTOLVAR and OT as PC-Dmis would ASSIGN it.
        Tried changing settings in the beginning to match what I have benn using. Also swapped 184 for (FEATURE_CONTROL_FRAME). Any ideas ?

        Comment


        • #5
          This works for me in 2014.1 - can't say if older versions are doing something differently...
          Code:
                      ASSIGN/OT=0
          CS1        =SCRIPT/FILENAME= C:\USERS\PUBLIC\DOCUMENTS\WAI\PC-DMIS\2014.1\COUNTOUTTOL.BAS
                      FUNCTION/CountOutOfTol,SHOW=YES,ARG1="OT",,
                      STARTSCRIPT/
                      ENDSCRIPT/
                      COMMENT/OPER,NO,FULL SCREEN=NO,AUTO-CONTINUE=NO,
                      OT
          AndersI
          SW support - Hexagon Metrology Nordic AB

          Comment


          • #6
            I'm trying to do this as an executable (.exe) file instead of a .bas file. Did try it as a .bas file a couple of times, but value is not passing. Also, cannot insert ENDSCRIPT/ Command into PC-DMIS. Keeps going to ENDGROUP or ENDSUB.

            Comment


            • #7
              I think if you set PC-DMIS to show header/footer, the number of out of tolerance features will be at the bottom (in the footer).

              Comment


              • #8
                Need to keep PC-DMIS from changing the "WAIT" to "NO_WAIT" in the EXTERNALCOMMAND line. It runs fine for a while then flipst. Of course, I have to re-load the programs again. I think I saw something about locking a command line so that PC-DMIS can't change the settings in it. You're suppose to put something in front of it ??? Hate when I can't remember... LOL !!!
                Last edited by SunfireSSR; 06-05-2015, 07:18 AM.

                Comment


                • #9
                  Can you add a compressed file COUNTOUTOFTOL.BAS? Thanks!!
                  I also ENDSCRITP / do not add up.
                  Last edited by mert1i; 07-29-2015, 10:11 AM.

                  Comment


                  • #10
                    NOTE: There's a much better solution here: http://www.pcdmisforum.com/showthrea...l=1#post401750


                    For those interested, my script missed (at least) outtols in the second segment of composite FCF:s. Edited version:

                    Code:
                    '--------------------------------------------------------------------
                    ' Count all dimensions out of tolerance
                    ' Set the indicated PCDMIS variable to the number
                    '
                    ' Usage:
                    '
                    '            TILLDELA/OT=0
                    'CS1        =SKRIPT/FILNAMN= C:\DOCUMENTS AND SETTINGS\ALL USERS\DOKUMENT\WAI\PC-DMIS\2010 MR2\COUNTOUTOFTOL.BAS
                    '            FUNKTION/CountOutOfTol,VISA=JA,ARG1="OT",,
                    '            BÖRJA_SKRIPT/
                    '            SLUTA_SKRIPT/
                    '
                    '            KOMMENTAR/OPERATÖR,NEJ,HELSKÄRM=NEJ,FORTSÄTT AUTOMATISKT=NEJ,
                    '            Antal utvärderingar utom tolerans
                    '            OT
                    '
                    '--------------------------------------------------------------------
                    
                    Sub CountOutOfTol(OutTolVar As String)
                    
                    Dim App As Object
                    Set App = CreateObject("PCDLRN.Application")
                    Dim Part As Object
                    Set Part = App.ActivePartProgram
                    Dim Cmds As Object
                    Set Cmds = Part.Commands
                    Dim Cmd As Object
                    Dim DCmd As Object
                    Dim FCFOT As String
                    Dim I As Integer
                    
                    Dim OutTolValue As Object
                    Set OutTolValue = Part.GetVariableValue(OutTolVar)
                    
                    If Not OutTolValue is Nothing Then
                    
                      OutTolValue.LongValue = 0
                    
                      For Each Cmd In Cmds
                    
                        If Cmd.IsDimension 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
                            Set DCmd = Cmd.DimensionCommand
                            if (DCmd.OutTol <> 0) then
                              OutTolValue.LongValue = OutTolValue.LongValue + 1
                            End If
                          End If
                        ElseIf Cmd.Type = 184 Then ' FCF
                          I = 1
                          FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
                          While (Not OutOfTol) And (FCFOT <> "")
                            If Val(FCFOT) <> 0 Then
                              OutTolValue.LongValue = OutTolValue.LongValue + 1
                            End If
                            I = I + 1
                            FCFOT = Cmd.GetText (LINE2_OUTTOL, I)
                          Wend
                          I = 1
                          FCFOT = Cmd.GetText (LINE3_OUTTOL, I)
                          While (Not OutOfTol) And (FCFOT <> "")
                            If Val(FCFOT) <> 0 Then
                              OutTolValue.LongValue = OutTolValue.LongValue + 1
                            End If
                            I = I + 1
                            FCFOT = Cmd.GetText (LINE3_OUTTOL, I)
                          Wend
                        End If
                      Next Cmd
                    
                      If Not OutTolValue is Nothing Then
                        Part.SetVariableValue OutTolVar, OutTolValue
                      End If
                    
                    Else
                       MsgBox "Variabeln " + OutTolVar + " saknas i PCDMIS-programmet!"
                    End If
                    
                    End Sub
                    
                    Sub Main
                    End Sub
                    Last edited by AndersI; 08-17-2015, 09:01 AM.
                    AndersI
                    SW support - Hexagon Metrology Nordic AB

                    Comment

                    Related Topics

                    Collapse

                    Working...
                    X