examplemodule.bas

PLC相关-656M.zip

Attribute VB_Name = "ExampleModule"
Option Explicit

'Teil: M O D U L E

Public Sub AllModuleData(Modu As S7Module)
Dim str As String
On Error Resume Next
    str = "Name: " & Modu.Name & Chr(13) & _
    "LogPath: " & Modu.LogPath & Chr(13) & _
    "Modules.Count: " & Modu.Modules.count & Chr(13) & _
    "MLFB: " & Modu.MLFB & Chr(13) & _
    "Index (Steckplatz:) " & Modu.Index & Chr(13) & _
    "LocalInAddresses.Count: " & Modu.LocalInAddresses.count & Chr(13) & _
    "LocalOutAddresses.Count: " & Modu.LocalOutAddresses.count & Chr(13) & _
    "CpuInAddresses.Count: " & Modu.CpuInAddresses.count & Chr(13) & _
    "CpuOutAddresses.Count: " & Modu.CpuOutAddresses.count & Chr(13)

    str = str & "Index des Subsystems: " & Modu.SubSystem.Index & Chr(13)
    If CatchError(False) Then
        str = str & "Index des Subsystems: Nothing" & Chr(13)
    End If
        
    str = str & "PROFIBUSAddress: " & Modu.PROFIBUSAddress & Chr(13)
    If CatchError(False) Then
        str = str & "PROFIBUSAddress: Nothing" & Chr(13)
    End If
    
    str = str & _
          "Version: " & Modu.Version & Chr(13) & _
          "Autocreated: " & Modu.Autocreated & Chr(13)
          
    MsgBox str, vbInformation, "Daten des Moduls " & Modu.Name
End Sub


Public Sub ExampleModule1()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim Modu As S7Module
    Dim dlg As New AttributesDlg
    Dim count As Integer
                                           
On Error Resume Next
    ' Ermittle Station "relativity"
    count = S.Projects("reptiles").Stations("relativity").Racks.count
    If CatchError Or (count = 0) Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt. Au遝rdem m黶sen Racks vorhanden sein."
        Exit Sub
    End If
                                           
    Set Sta = S.Projects("reptiles").Stations("relativity")
                                               
    ' Versuche PS in Rack 2, Slot 2 zu stecken.
    Set Rac = Sta.Racks(2)
    If CatchError Then Exit Sub

    ' Fehler: Die Baugruppe kann nur auf Steckplatz 1 gesteckt werden
    Call Rac.Modules.add("eine PS307 10A", "6ES7 307-1KA00-0AA0", "", 2)
    CatchError
    
    ' Jetzt ohne Fehler: PS ins Rack 2 auf Platz 1
    Call Rac.Modules.add("eine PS307 10A", "6ES7 307-1KA00-0AA0", "", 1)
    CatchError
    
    ' Und das gleiche nochmals fuer Rack 0 und 1
    Call Sta.Racks(0).Modules.add("noch eine PS307 10A", "6ES7 307-1KA00-0AA0", "", 1)
    CatchError
    
    Call Sta.Racks(1).Modules.add("die dritte PS307 10A", "6ES7 307-1KA00-0AA0", "", 1)
    CatchError

    ' Infos ueber das Modul, und die Attribute
    Set Modu = Sta.Racks(1).Modules(1)
    
    Call AllModuleData(Modu)
    CatchError
    
    Set dlg.Obj = Modu
    dlg.Caption = "Attribute des Modules " & Modu.Name
    dlg.Show vbModal
    CatchError
End Sub


Public Sub UndoExampleModule1()
    Dim Sta As S7Station
    Dim count As Integer
    Dim Rac As S7Rack
    Dim result
    
On Error Resume Next
    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 in allen Racks der Station 'relativity' " _
        & "die Module im Steckplatz 1 (Stromversorgung) gel鰏cht werden?", _
        vbYesNo, "Undo Example Moudle 1")
    If result <> vbYes Then Exit Sub
    
    For Each Rac In Sta.Racks
        Rac.Modules(1).Remove
        CatchError (True)
    Next
    
    MsgBox "done.", , "Undo Example Module 1"
End Sub


Public Sub ExampleModule2()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim Modu As S7Module
    Dim count As Integer
                                           
On Error Resume Next
    ' Ermittle Station "relativity"
    count = S.Projects("reptiles").Stations("relativity").Racks.count
    If CatchError Or (count = 0) Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt. Au遝rdem m黶sen Racks vorhanden sein."
        Exit Sub
    End If
                                           
    Set Sta = S.Projects("reptiles").Stations("relativity")
    
    ' Stecke in Rack 0 die Baugruppe IM 360 IM S
    MsgBox ("Stecke Sender IM 360 IM S in Rack 0")
    Set Modu = Sta.Racks(0).Modules.add("Sender IM 360 IM S", _
        "6ES7 360-3AA00-0AA0", "", 3)
    If Not CatchError Then AllModuleData Modu
    
    ' Stecke in Rack 1 und 2 die Baugruppe IM 361 IM R
    MsgBox ("Stecke Empfaenger IM 361 IM R in Rack 1 und 2")
    Set Modu = Sta.Racks(1).Modules.add("Empfaenger IM 361 IM R", _
        "6ES7 361-3CA00-0AA0", "", 3)
    If Not CatchError Then AllModuleData Modu
    
    Set Modu = Sta.Racks(2).Modules.add("Empfaenger IM 361 IM R", _
        "6ES7 361-3CA00-0AA0", "", 3)
    If Not CatchError Then AllModuleData Modu
    
    MsgBox ("fertig.")
End Sub


Public Sub UndoExampleModule2()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim Modu As S7Module
    Dim result
    
On Error Resume Next
    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 in der Station 'relativity' " _
        & "die 3 Module IM 460-0 bzw. IM 461-0 gel鰏cht werden?", _
        vbYesNo, "Undo Example Moudle 2")
    If result <> vbYes Then Exit Sub

    ' Loesche Module
    Sta.Racks(0).Modules(3).Remove: CatchError
    Sta.Racks(1).Modules(3).Remove: CatchError
    Sta.Racks(2).Modules(3).Remove: CatchError
        
    MsgBox ("done.")
End Sub


Public Sub ExampleModule3()
    Dim Sta As S7Station
    Dim Rac As S7Rack
    Dim Modu As S7Module, SubModu As S7Module
    Dim dlg As New AttributesDlg
    Dim count As Integer
                                           
On Error Resume Next
    ' Ermittle Station "relativity"
    count = S.Projects("reptiles").Stations("relativity").Racks.count
    If CatchError Or (count = 0) Then
        MsgBox "Es wird das Project 'Reptiles' und die Station " _
            & "'Relativity' benoetigt. Au遝rdem m黶sen Racks vorhanden sein."
        Exit Sub
    End If
                                           
    Set Sta = S.Projects("reptiles").Stations("relativity")
    
    ' Anzahl der SubSysteme
    MsgBox ("Es gibt " & Sta.SubSystems.count & " Subsysteme")
    
    ' Ermittle Rack 0
    Set Rac = Sta.Racks(0)
    
    ' Erzeuge nun die CPU
    MsgBox ("Nun wird die CPU angelegt.")
    Set Modu = Rac.Modules.add("eine CPU315-2 DP", "6ES7 315-2AF82-0AB0", "", 2)
    
    If Not CatchError Then
        ' Lege Subsystem an
        
        Call Modu.Modules(1).AddSubSystem("Netz1", 1)
        CatchError
    End If
    
    ' Infos "uber alle Module des Racks
    For Each Modu In Rac.Modules
        Call AllModuleData(Modu)
        Set dlg.Obj = Modu
        dlg.Caption = "Attribute des Modules " & Modu.Name
        dlg.Show vbModal
    Next
    
    ' Infos "uber das Sub-Modul der CPU
    MsgBox ("Informationen ueber das Submodul der CPU")
    For Each Modu In Rac.Modules(2).Modules
        Call AllModuleData(Modu)
        Set dlg.Obj = Modu
        dlg.Caption = "Attribute des Modules " & Modu.Name
        dlg.Show vbModal
    Next
    
    ' Anzahl der SubSysteme
    MsgBox ("Jetzt gibt es " & Sta.SubSystems.count & " Subsysteme")
End Sub


Public Sub UndoExampleModule3()
    Dim Sta As S7Station
    Dim result
    
On Error Resume Next
    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("Soll die CPU samt SubSystem gel鰏cht werden?", _
        vbYesNo, "Undo Example Moudle 3")
    If result <> vbYes Then Exit Sub
    
    ' Loeschen
    Sta.Racks(0).Modules(2).Remove
    If Not CatchError Then MsgBox "done."
End Sub