cedricthalgott
Messages postés2Date d'inscriptionjeudi 25 février 2010StatutMembreDernière intervention25 février 2010
-
25 févr. 2010 à 13:30
cedricthalgott
Messages postés2Date d'inscriptionjeudi 25 février 2010StatutMembreDernière intervention25 février 2010
-
25 févr. 2010 à 13:46
Bonjour a tous,
Je developpe actuellement un fichier sous EXCEL 2000 pour recuperer des valeurs sur un automate TSX 3721 via un serveur OPC FACTORY SERVER Ver 3.30 DEMO.
Voici mon probleme:
La connection se passe bien, la creation des groupes egalement ainsi que la creation des items.
Par contre lorsque je viens lancer la commande "GR0.SyncRead OPC_DS_DEVICE, NBITEMS, tabItemsHdlSrv, pValues, pErrors, pQualites, pTimeStamp" la page de diagnostique de OPC FACTORY SERVER me met ce message en rouge "NETMAN : Request Time Out for device : UNTLW01:0.254.0" et celui ci "Sync Read failure:UNTLW01.0.254.0".
Voici mon prog :
Option Base 1
Const ProgID$ = "Schneider-Aut.OFSSimu" 'Nom du simulateur OPC Schneider.
Const ProgID1$ = "Schneider-Aut.OFS" 'Nom du serveur OPC Schneider.
Const dwlangld_ENGLISH = &H409 'Message OPC en langue Anglaise.
Const dwlangld_FRANCAIS = &H40C 'Message OPC en langue Française.
Const S_OK = 0 'Initialisation S_OK.
Const OPC_DS_DEVICE = 2 'Lecture du DEVICE.
' *** Constantes application test
Const NBITEMS = 20 'Nombre d'Items Max dans chaque groupe.
' *** Définition des variables **
Dim hndClientItemCouter As Long '
Dim contiRead As Boolean '
Dim isFormActivated As Boolean '
Dim isShuttingDown As Boolean 'True when continuous read over.
Dim isErrorStringFAILED As Boolean 'Avoid infinite recursive error.
Dim driverPLC As String 'Nom du driver selectionné.
Dim PrgID As String 'Nom du serveur selectionné.
Dim HostServeur As String 'Nom du PC serveur OFS
Dim NumGR As Variant 'Numéro du groupe.
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Dim WithEvents OpcFactoryServer As OPCServer 'Interface OPC Automation2
'==========================================================================================
'*********************************** LISTE GROUPES *************************************
Dim ListOfsGroups As OPCGroups 'Liste des groupes
'----- GR0 ------------
Dim WithEvents GR0 As OPCGroup 'Un Groupe GR0 contient le mot fin de cycle frettage et 3 autres parametres libres
Dim WithEvents GR1 As OPCGroup 'Un Groupe GR1 contient le Nom operateur et les parametres Gamme courante
Dim WithEvents GR2 As OPCGroup 'Un Groupe GR2 contient les valeurs Course, Force
'==========================================================================================
'*********************************** COLLECTION ITEMS *************************************
Dim GRItemCollection As OPCItems 'Collection d'Items
Const IdentMot = "%MW"
Dim Mot, Mot2, ProgVide
Dim NumProg As Byte 'Index num prog
'----- GR0 (mot fin de cycle frettage)------------
Const NumgrpGR0 = 0 'Numéro du groupe N°0.
Const nbritemsGR0 = 1 'Nombre d'Items dans le groupe (%MW200 A %MWx).
Dim tabItmGR0HndCli(1 To nbritemsGR0) As Long '
Dim tabItmGR0HndSrv(1 To nbritemsGR0) As Long '
Dim hndSrvGrpGR0 As Long '
Const NbEcrItemGR0 = 20 'Nombre d'Items en écriture.
'----- GR1 (Nom operateur,Gamme courante)------------
Const NumgrpGR1 = 1 'Numéro du groupe N°1.
Const nbritemsGR1 = 2 'Nombre d'Items dans le groupe (%MW200 A %MWx).
Dim tabItmGR1HndCli(1 To nbritemsGR1) As Long '
Dim tabItmGR1HndSrv(1 To nbritemsGR1) As Long '
Dim hndSrvGrpGR1 As Long '
Const NbEcrItemGR1 = 20 'Nombre d'Items en écriture.
Dim IndItemGR1
Dim LongItemGR1
'----- GR2 (Course, Force)------------
Const NumgrpGR2 = 2 'Numéro du groupe N°2.
Const nbritemsGR2 = 2 'Nombre d'Items dans le groupe (%MW200 A %MWx).
Dim tabItmGR2HndCli(1 To nbritemsGR2) As Long '
Dim tabItmGR2HndSrv(1 To nbritemsGR2) As Long '
Dim hndSrvGrpGR2 As Long '
Const NbEcrItemGR2 = 20 'Nombre d'Items en écriture.
Dim IndItemGR2
'==========================================================================================
'************************ ACTIVATION DU SERVEUR OU SIMULATEUR OPC *************************
Function Connect()
PrgID = ProgID1$
Set OpcFactoryServer = New OPCServer
OpcFactoryServer.Connect PrgID$
If (Err.Number <> S_OK) Or (OpcFactoryServer Is Nothing) Then
warning "1000: error during creating " + PrgID$, (Err.Number)
End If
Set ListOfsGroups = OpcFactoryServer.OPCGroups 'Initialisation de la liste des groupes
' Caractéristiques de tous les groupes.
ListOfsGroups.DefaultGroupIsActive = False 'Groupes désactivés.
ListOfsGroups.DefaultGroupUpdateRate = 2000 '500 'Temps de cycle(ms).
ListOfsGroups.DefaultGroupDeadband = 1 '
ListOfsGroups.DefaultGroupLocaleID = dwlangld_FRANCAIS 'Messages en Français.
'----- GR0 (mot fin de cycle frettage)------------
If Not createGR0Grp() Then isFormActivated = True 'Creation OPC Group GR0;appel sous-programme createGR0Grp
'----- GR1 (Nom operateur,Gamme courante)------------
If Not createGR1Grp() Then isFormActivated = True
'----- GR2 (Course, Force)------------
If Not createGR2Grp() Then isFormActivated = True
'End If
End Function
'==========================================================================================
'*********************************** CREATION GR0 *****************************************
Function createGR0Grp() As Boolean
Dim rateDummy As Long
Dim ItemsDef(nbritemsGR0) As String 'Tableau des noms Item.
Dim i
On Error Resume Next
Set GR0 = ListOfsGroups.Add("GR0") 'Initialise le groupe GR0 à la liste des groupes.
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then
warning "1010: can't load the main OPC group", (Err.Number)
End If
Set GRItemCollection = GR0.OPCItems 'Initialise la collection d'Items.
GR0.UpdateRate = 200
'---Definition des Items du groupe GR0.---
' Donner le premier mot automate et la longueur de la liste de données
'For i = 1 To nbritemsGR0
'Mot = IdentMot & 200 + (i - 1) * 20 & ":20"
ItemsDef(1) "UNTLW01:0.254.0!%MW6:4" 'ItemsDef(1) "UNTLW01:0.254.0!%PremierMot:Longueur"
'Next
'---Appel procedure création d'Items.---
createItems ItemsDef(), tabItmGR0HndCli(), tabItmGR0HndSrv(), nbritemsGR0 'Appel sous-programme "createItems"
GR0.IsActive = True
GR0.IsSubscribed = True
End Function
'==========================================================================================
'*********************************** CREATION GR1 *****************************************
Function createGR1Grp() As Boolean
Dim rateDummy As Long
Dim ItemsDef(nbritemsGR1) As String 'Tableau des noms Item.
Dim i
On Error Resume Next
Set GR1 = ListOfsGroups.Add("GR1") 'Initialise le groupe GR1 à la liste des groupes.
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then
warning "1010: can't load the main OPC group", (Err.Number)
End If
Set GRItemCollection = GR1.OPCItems 'Initialise la collection d'Items.
GR1.UpdateRate = 200
For i = 1 To nbritemsGR1
If i = 1 Then
IndItemGR1 100: LongItemGR1 12
ElseIf i = 2 Then
IndItemGR1 60: LongItemGR1 20
End If
'---Definition des Items du groupe GR1.---
' Donner le premier mot automate et la longueur de la liste de données
ItemsDef(i) "UNTLW01:0.254.0!" & IdentMot & IndItemGR1 & ":" & LongItemGR1 'ItemsDef(1) "UNTLW01:0.254.0!%PremierMot:Longueur"
Next
'---Appel procedure création d'Items.---
createItems ItemsDef(), tabItmGR1HndCli(), tabItmGR1HndSrv(), nbritemsGR1 'Appel sous-programme "createItems"
GR1.IsActive = True
GR1.IsSubscribed = True
End Function
'==========================================================================================
'*********************************** CREATION GR2 *****************************************
Function createGR2Grp() As Boolean
Dim rateDummy As Long
Dim ItemsDef(nbritemsGR2) As String 'Tableau des noms Item.
Dim i
On Error Resume Next
Set GR2 = ListOfsGroups.Add("GR2") 'Initialise le groupe GR2 à la liste des groupes.
If (Err.Number <> S_OK) Or (ListOfsGroups Is Nothing) Then
warning "1010: can't load the main OPC group", (Err.Number)
End If
Set GRItemCollection = GR2.OPCItems 'Initialise la collection d'Items.
GR2.UpdateRate = 200 '200
For i = 1 To nbritemsGR2
IndItemGR2 = [color=blue]1001 + (i - 1) * 1500 '1001 + (i - 1) * 1500
'Definition des Items du groupe GR1.
ItemsDef(i) "UNTLW01:0.254.0!" & IdentMot & IndItemGR2 & ":1500" '":1500" 'ItemsDef(1) "UNTLW01:0.254.0!%MW2501:700"
Next
'---Appel procedure création d'Items.---
createItems ItemsDef(), tabItmGR2HndCli(), tabItmGR2HndSrv(), nbritemsGR2 'Appel sous-programme "createItems"
GR2.IsActive = True
GR2.IsSubscribed = True
End Function
'==========================================================================================
'*********************************** CREATION ITEMS *****************************************
' Creation items of group: IN:ItemsDef() name of items, OUT:tabItemsHdlSrv()
Sub createItems(ItemsDef() As String, tabItemsLocHdlClient() As Long, _
tabItemsHdlSrv() As Long, nbrItems As Long)
Dim indItem%
Dim ItemsActivity(NBITEMS) As Boolean
Dim tabItemsLocHdlSrv() As Long
hndClientItemCouter = 0
For indItem% = 1 To nbrItems
ItemsActivity(indItem%) = True ' Item actif par défaut
hndClientItemCouter = hndClientItemCouter + 1
tabItemsLocHdlClient(indItem%) = hndClientItemCouter
Next
On Error Resume Next
' Creation de tous les Items OPC pour le Groupe
For indItem% = 1 To nbrItems
GRItemCollection.AddItem ItemsDef(indItem%), tabItemsLocHdlClient(indItem%)
tabItemsHdlSrv(indItem%) = GRItemCollection.Item(indItem%).ServerHandle
If Err.Number <> S_OK Then
warning "1040: Can't create the items " + "of the group" + vbCrLf + vbCrLf + _
"Possible Causes : " + vbCrLf, (Err.Number)
End If
Next
On Error GoTo 0
End Sub
'==========================================================================================
'*********************************** LECTURE DU GROUPE ************************************
Function readGroup(interfaceOfGroup As OPCGroup, tabItemsLocHdlClient() As Long, tabItemsHdlSrv() As Long, NBITEMS As Long, NumGR As Variant)
Dim numItem As Long
Dim pValues() As Variant
Dim pQualites As Variant
Dim pTimeStamp As Variant
Dim pErrors() As Long
'--- Lecture
readGroup = False:
On Error Resume Next
On Error GoTo 0
GR0.SyncRead OPC_DS_DEVICE, NBITEMS, tabItemsHdlSrv, _
pValues, pErrors, pQualites, pTimeStamp
If Err.Number <> S_OK Then
warning "1070: Echec lecture Synchrone", (Err.Number)
End If
'For numItem = LBound(pValues) To UBound(pValues)
'GUIitemDisplayGR0 pValues(numItem), tabItemsLocHdlClient(numItem), pTimeStamp(numItem)
'Next
End Function
Par contre lorsque je mets ex: 450 et 15 a la place de la partie bleu dans le code le message d'erreur n'apparait pas.
Est ce que quelqu'un aurait une reponse pour moi ca m'aiderais enormement
