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)
'-------------------------------------------------------------------- ' 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