examplegeneral.bas

PLC相关-656M.zip

    For Each Sta In Pro.Stations
        Call Pro.Stations.Remove(Sta.Name)
        CatchError
    Next
    
    ' Gebe alle Stationsnamen aus
    AllStationNames Pro
End Sub


Public Sub ExampleStations2()
    Dim Pro As S7Project
    Dim Sta As S7Station
        
On Error Resume Next
    Set Pro = S.Projects("reptiles")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' benoetigt."
        Exit Sub
    End If
    
    ' Importiere die Station relativity
    MsgBox "Importiere Station aus" & Chr(13) & "c:\tmp\relativity.txt"
    Set Sta = Pro.Stations.Import("c:\tmp\relativity.txt")
    If CatchError Then Exit Sub
    
    ' Gebe Stationsdaten aus. Die Funktion stammt aus einen spaeteren
    ' Beispiel.
    Call AllStationData(Sta)
    
    ' benenne Station nach "Relativity2" um
    MsgBox "Benenne Station nach Relativity2 um."
    Sta.Name = "Relativity2"
    
    If CatchError(False) Then
        MsgBox "Da bereits eine Station 'Relativity2' vorhanden ist," & Chr(13) & _
            "wird die importierte Station wieder geloescht."
        Call Pro.Stations.Remove(Sta.Name)
        Exit Sub
    End If
    
    ' gebe nochmals Stationsdaten aus
    Call AllStationData(Sta)
End Sub


Public Sub UndoExampleStations2()
    Dim Sta As S7Station
    Dim result
    
On Error Resume Next
    ' Ermittle Station; ist sie ueberhaupt vorhanden?
    Set Sta = S.Projects("reptiles").Stations("Relativity2")
    If CatchError(False) Then Exit Sub
    
    ' Ja, es gibt die Station
    result = MsgBox("Soll die Station 'Relativity2' " & _
                "geloescht werden?", vbYesNo, "Undo Example Stations 2")
    If result <> vbYes Then Exit Sub
        
    ' Loesche die Station
    S.Projects("reptiles").Stations.Remove ("Relativity2")
    If CatchError Then Exit Sub
    
    ' FINE
    MsgBox "done."
End Sub


' TEIL: R A C K

Private Sub AllRackData(Rac As S7Rack)
On Error Resume Next
    MsgBox "Rack-Name: " & Rac.Name & Chr(13) & _
           "MLFB: " & Rac.MLFB & Chr(13) & _
           "Rack-Nr: " & Rac.Index & Chr(13) & _
           "LogPath: " & Rac.LogPath & Chr(13)
    CatchError
End Sub


Public Sub ExampleRack1()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim dlg As New AttributesDlg
                                    
On Error Resume Next
    ' Ermittle Station "relativity"
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' Lege 3 neue 300er-Rack an, die ersten beiden mit 18,
    MsgBox "Es werden 3 Racks angelegt."
    Call Sta.Racks.add("abakus", "6ES7 390-1???0-0AA0", "", 0)
    Call Sta.Racks.add("lizzard", "6ES7 390-1???0-0AA0", "", 2)
    Call Sta.Racks.add("Geckos", "6ES7 390-1???0-0AA0", "", 1)
    CatchError
    
    ' Noch ein Paar Infos ueber die Racks
    For Each Rac In Sta.Racks
        If Not CatchError Then
            Call AllRackData(Rac)
            Set dlg.Obj = Rac
            dlg.Caption = "Attribute des Racks " & Rac.Name
            dlg.Show vbModal
        End If
    Next
End Sub


Public Sub UndoExampleRack1()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim result
    
On Error Resume Next
    ' Sind Station und Rack vorhanden?
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError(False) Then Exit Sub
    If Sta.Racks.count = 0 Then Exit Sub
    
    ' Frage nach
    result = MsgBox("Sollen die Racks der Station 'relativity'" & Chr(13) _
        & "wirklich gel鰏cht werden?", vbYesNo, "Undo Example Rack")
    If result <> vbYes Then Exit Sub
    
    ' Loesche alle Racks
    For Each Rac In Sta.Racks
            Rac.Remove
            CatchError
    Next
    
    MsgBox "done.", , "Undo Example Rack"
End Sub


' TEIL: A D D R E S S

Public Sub ExampleAddress1()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim Modu As S7Module
    Dim Adr As S7Address
    Dim dlg As New AddressDlg
    
On Error Resume Next
    ' Ermittle Station "relativity"
    Set Sta = S.Projects("reptiles").Stations("relativity")
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt."
        Exit Sub
    End If
    
    ' Ermittle Rack Geckos
    Set Rac = Sta.Racks("Geckos")
    If CatchError Then
        MsgBox "Das Rack 'Geckos' ist nicht vorhanden."
        Exit Sub
    End If
    
    ' Fuege in Rack "Geckos" eine Wegerfassungsbaugruppe ein.
    Set Modu = Rac.Modules.add("Wegerfassung", _
        "6ES7 338-4BC00-0AB0", "", 4)
    
    If CatchError Then
        ' Wahrscheinlich ist das Modul schon vorhanden
        Set Modu = Sta.Racks("Geckos").Modules(4)
        If CatchError Then Exit Sub
    End If
    
    ' Zuerst die Moduldaten
    Call AllModuleData(Modu)

    ' Zeige Eingangsadressen an
    Set dlg.Adds = Modu.LocalInAddresses
    dlg.Caption = "Eingangsadresse"
    dlg.Show vbModal
        
    ' Zeige Ausgangsadressen an
    Set dlg.Adds = Modu.LocalOutAddresses
    dlg.Caption = "Ausgabeadresse"
    dlg.Show vbModal
End Sub


Public Sub UndoExampleAddress1()
    Dim Rac As S7Rack
    Dim Modu As S7Module
    Dim result
    
On Error Resume Next
    Set Rac = S.Projects("reptiles").Stations("relativity").Racks("Geckos")
    If CatchError(False) Then Exit Sub
    
    Set Modu = Rac.Modules(4)
    If CatchError(False) Then Exit Sub
    
    ' Frage nach
    result = MsgBox("Soll die Wegerfassungsbaugruppe aus dem" & Chr(13) _
        & "Geckos gel鰏cht werden?", vbYesNo, "Undo Example Address")
    If result <> vbYes Then Exit Sub
        
    ' L鰏che Objekt
    Modu.Remove
    If Not CatchError Then MsgBox "done."
End Sub


' TEIL: S U B S Y S T E M


Public Sub AllSubSystemData(SubS As S7SubSystem)
On Error GoTo Error1
    MsgBox "Name: " & SubS.Name & Chr(13) & _
            "Index: " & SubS.Index & Chr(13) & _
            "Anzahl der Slaves: " & SubS.Slaves.count & Chr(13) & _
            "SubnetName: " & SubS.SubnetName, _
            vbInformation, "Daten des Subsystems " & SubS.Name
    Exit Sub
Error1:
    CatchError
End Sub


Public Sub ExampleSubSystem1()
    Dim Modu As S7Module
    Dim SubS As S7SubSystem
    Dim dlg As AttributesDlg
    
On Error Resume Next
    ' Voraussetzung: Project Reptiles, Station Relativity, Rack 1,
    ' Module 2
    Set Modu = S.Projects("reptiles").Stations("relativity"). _
        Racks(0).Modules(2)
    
    If CatchError(False) Then
        MsgBox "Die CPU aus Bsp. Module3 ist nicht vorhanden."
        Exit Sub
    End If
    
    ' Ist es auch das richtige Modul?
    If Modu.MLFB <> "6ES7 315-2AF82-0AB0" Then
        MsgBox "Das Module, das im Project 'reptiles', Station 'relativity', " _
            & Chr(13) & "Rack 0, Steckplatz 2, steckt, ist nicht das gleiche " _
            & Chr(13) & "wie aus Beispiel Module3."
        Exit Sub
    End If
    
    ' Gebe die Daten des Submodules aus
    AllModuleData Modu.Modules(1)
    
    ' wenn ein Subsystem vorhanden ist, so werden auch diese Daten ausgegeben
    ' Methode: Try and Error
    Set SubS = Modu.Modules(1).SubSystem
    If CatchError(False) Then
        ' Das Property SubSystem war wohl nothing, deshalb der Fehler
        Exit Sub
    Else
        ' es ist ein SubSystem vorhanden
        AllSubSystemData SubS
        Set dlg.Obj = SubS
        dlg.Caption = "Attribute des SubSystems " & SubS.Name
        dlg.Show vbModal
    End If
End Sub


' TEIL:     T E R M I N A L   B L O C K


Public Sub ExampleTerminalBlock()
    Dim SubS As S7SubSystem
    Dim Sla As S7Slave
    Dim TerBlo As S7Rack
    Dim Modu As S7Module
    
    ' Ermittle das SubSystem 1 der Station "relativity"
On Error Resume Next
    Set SubS = S.Projects("reptiles").Stations("relativity").SubSystems(1)
    If CatchError Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt. Au遝rdem mu