Automatic probe calibration script

Yes Jan d.,
You said all the interest it give to write such a script.

The zz= actuprb.qualify2 works but the problem is that it doesn't take in account the selected tips positions made before in the script. It ask if I want to calibrate all the positions.

I have also tried to use the actuprb.qualify command wich take in account the selected tips positions but if i haven't calibrate one probe just before to run the script, it doesn't work.
I think there's something missing in the script but what???

I'm using PCDMIS V3.7 MR3

For those who don't see the attached file, see the script lines just after:

' Routine de calibration automatique de tous les palpeurs utilisés dans un programme
'
Sub main
' ces variables sont pour acceder à l'application PC-DMIS
Dim Application As Object
Dim part As Object
Dim cmds As Object
Dim cmd As Object
Dim prb As Object
'
'
' these variables are used To manipulate
' the return value from GetToggleString
Dim togglestring As String
Dim togglecount As Integer
' probes variables And tool variable
Dim actuprb As Object
Dim actutip As Object
Dim posactu As Object
Dim actusettings As Object
Dim actutool As Object
Dim actusphere As Object
'
Dim palpactuel, posactuel As String
Dim s As String
Dim i,palpdeb As Integer
Dim tt,newpalpeur,zz As Boolean
'
' Get the application variable And make sure it is valid
Set Application = CreateObject("PCDLRN.Application")
If Application is Nothing Then
msgbox "Impossible de trouver l'application PCDMIS --> fin de la procédure."
End
End If
'
' Get the part variable And make sure it is valid
Dim programs As Object
'
Set programs = Application.PartPrograms
Set part = Application.ActivePartProgram
'
partname = part.fullname
If part is Nothing Then
msgbox "Impossible de trouver un programme actif --> fin de la procédure."
End
End If
' Get the cmds variable And make sure it is valid
Set cmds = part.Commands
If cmds is Nothing Then
msgbox "Impossible de trouver les commandes du programme --> fin de la procédure."
End
End If
'
'
Dim palpeur (6) As String
Dim positions(6) As String
Dim ii,jj,nbpalp As Integer
'
For jj=1 To 6
palpeur (jj)=" "
Next
'
'*****************************************************************************************************
' Loop over all the commands To find used probes
' pour trouver tous les palpeurs utilisés
For Each cmd In cmds
'
If cmd.Type=61 Then '61 est commande charg palpeur / load probe command
togglestring=cmd.gettext(file_name,0)
newpalpeur=True
For jj=1 To 6
If palpeur(jj)=togglestring Then
newpalpeur=False
End If
Next jj
'
If newpalpeur=True Then
ii=ii+1
palpeur(ii)=togglestring
End If
End If
'
Next cmd
'
'*****************************************************************************************************
'
nbpalp=ii
'
Dim numligne%
Dim txt$
numligne=1
'
'*****************************************************************************************************
' Loop over all the commands To find all tip positions
' pour trouver toutes les positions palpeurs utilisées
For Each cmd In cmds
'
If cmd.Type=61 Then '61 est commande charg palpeur / load probe command

palpactuel=cmd.gettext(file_name,0)
For jj=1 To nbpalp
If palpeur(jj)=palpactuel Then
ii=jj
End If
Next jj

End If

If cmd.Type=60 Then '60 est commande contact... / 60= Select tip command
posactuel=cmd.gettext(id,0)
'
txt$=positions(ii)
txt$=txt$ & posactuel & ";"
positions(ii)= txt$
'
End If
numligne=numligne+1
Next cmd
'
'*****************************************************************************************************
'

'*************************************************************************
' Calibration de tous les palpeurs détectés précédemment
' Calibrate all probes And positions detected before
'*************************************************************************
'
Dim nomoutil$
Set prb= part.probes
Set actutool=part.tools
Set actusphere=actutool.item(1)
togglestring=palpeur(1)
txt$=positions(1)
Set actuprb=prb.item(togglestring)
Set actutip=actuprb.tips
Set actusettings=actuprb.qualificationsettings
tt= actusettings.settool(actusphere)

'zz= actuprb.qualify2 (actusettings)
'
For ii=1 To nbpalp
'
'actusettings.toolmoved=1
togglestring=palpeur(ii)
txt$=positions(ii)
Set actuprb=prb.item(togglestring)
Set actutip=actuprb.tips
For jj=1 To actutip.count
Set posactu=actutip.item (jj)
nomoutil$= posactu.id
If instr(1,positions(ii),nomoutil$) Then
posactu.selected=True
Else
posactu.selected=False
End If
Next
'
msgbox togglestring & " " & txt$
'
tt= actuprb.qualify2 (actusettings)
Next
'
msgbox "Qualification terminée !!"
End
'
End Sub

Yes Jan d.,
You said all the interest it give to write such a script.

The zz= actuprb.qualify2 works but the problem is that it doesn't take in account the selected tips positions made before in the script. It ask if I want to calibrate all the positions.

I have also tried to use the actuprb.qualify command wich take in account the selected tips positions but if i haven't calibrate one probe just before to run the script, it doesn't work.
I think there's something missing in the script but what???

I'm using PCDMIS V3.7 MR3

For those who don't see the attached file, see the script lines just after:

' Routine de calibration automatique de tous les palpeurs utilisés dans un programme
'
Sub main
' ces variables sont pour acceder à l'application PC-DMIS
Dim Application As Object
Dim part As Object
Dim cmds As Object
Dim cmd As Object
Dim prb As Object
'
'
' these variables are used To manipulate
' the return value from GetToggleString
Dim togglestring As String
Dim togglecount As Integer
' probes variables And tool variable
Dim actuprb As Object
Dim actutip As Object
Dim posactu As Object
Dim actusettings As Object
Dim actutool As Object
Dim actusphere As Object
'
Dim palpactuel, posactuel As String
Dim s As String
Dim i,palpdeb As Integer
Dim tt,newpalpeur,zz As Boolean
'
' Get the application variable And make sure it is valid
Set Application = CreateObject("PCDLRN.Application")
If Application is Nothing Then
msgbox "Impossible de trouver l'application PCDMIS --> fin de la procédure."
End
End If
'
' Get the part variable And make sure it is valid
Dim programs As Object
'
Set programs = Application.PartPrograms
Set part = Application.ActivePartProgram
'
partname = part.fullname
If part is Nothing Then
msgbox "Impossible de trouver un programme actif --> fin de la procédure."
End
End If
' Get the cmds variable And make sure it is valid
Set cmds = part.Commands
If cmds is Nothing Then
msgbox "Impossible de trouver les commandes du programme --> fin de la procédure."
End
End If
'
'
Dim palpeur (6) As String
Dim positions(6) As String
Dim ii,jj,nbpalp As Integer
'
For jj=1 To 6
palpeur (jj)=" "
Next
'
'*****************************************************************************************************
' Loop over all the commands To find used probes
' pour trouver tous les palpeurs utilisés
For Each cmd In cmds
'
If cmd.Type=61 Then '61 est commande charg palpeur / load probe command
togglestring=cmd.gettext(file_name,0)
newpalpeur=True
For jj=1 To 6
If palpeur(jj)=togglestring Then
newpalpeur=False
End If
Next jj
'
If newpalpeur=True Then
ii=ii+1
palpeur(ii)=togglestring
End If
End If
'
Next cmd
'
'*****************************************************************************************************
'
nbpalp=ii
'
Dim numligne%
Dim txt$
numligne=1
'
'*****************************************************************************************************
' Loop over all the commands To find all tip positions
' pour trouver toutes les positions palpeurs utilisées
For Each cmd In cmds
'
If cmd.Type=61 Then '61 est commande charg palpeur / load probe command

palpactuel=cmd.gettext(file_name,0)
For jj=1 To nbpalp
If palpeur(jj)=palpactuel Then
ii=jj
End If
Next jj

End If

If cmd.Type=60 Then '60 est commande contact... / 60= Select tip command
posactuel=cmd.gettext(id,0)
'
txt$=positions(ii)
txt$=txt$ & posactuel & ";"
positions(ii)= txt$
'
End If
numligne=numligne+1
Next cmd
'
'*****************************************************************************************************
'

'*************************************************************************
' Calibration de tous les palpeurs détectés précédemment
' Calibrate all probes And positions detected before
'*************************************************************************
'
Dim nomoutil$
Set prb= part.probes
Set actutool=part.tools
Set actusphere=actutool.item(1)
togglestring=palpeur(1)
txt$=positions(1)
Set actuprb=prb.item(togglestring)
Set actutip=actuprb.tips
Set actusettings=actuprb.qualificationsettings
tt= actusettings.settool(actusphere)

'zz= actuprb.qualify2 (actusettings)
'
For ii=1 To nbpalp
'
'actusettings.toolmoved=1
togglestring=palpeur(ii)
txt$=positions(ii)
Set actuprb=prb.item(togglestring)
Set actutip=actuprb.tips
For jj=1 To actutip.count
Set posactu=actutip.item (jj)
nomoutil$= posactu.id
If instr(1,positions(ii),nomoutil$) Then
posactu.selected=True
Else
posactu.selected=False
End If
Next
'
msgbox togglestring & " " & txt$
'
tt= actuprb.qualify2 (actusettings)
Next
'
msgbox "Qualification terminée !!"
End
'
End Sub