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
