examplegeneral.bas

PLC相关-656M.zip

Attribute VB_Name = "ExampleGeneral"
Public S As New Simatic
Option Explicit


' TEIL: S I M A T I C

Public Sub AllProjectData(Pro As S7Project)
    Dim str As String
    str = "Name: " & Pro.Name & Chr(13) & "Type: "
           
    If Pro.Type = S7Library Then
        str = str & "S7Library"
    ElseIf Pro.Type = S7Project Then
        str = str & "S7Project"
    Else
        str = str & "I don't know'"
    End If
        
    str = str & Chr(13) & "Logical Path: " & Pro.LogPath & Chr(13) & _
           "Anzahl der Programme: " & Pro.Programs.count & Chr(13) & _
           "Anzahl der Stationen: " & Pro.Stations.count
           
    MsgBox str, vbInformation, "Daten des Projekts " & Pro.Name
End Sub


Public Sub ExampleCollection()
    ' Deklaration der Variablen
    Dim Proj As Object
           
    ' Iteration ueber alle Projekte, die vom Simatic-Manager verwaltet werden.
    For Each Proj In S.Projects
        Call AllProjectData(Proj)
    Next

    ' Nun noch die Anzahl der Projekte
    MsgBox "Es gibt " & S.Projects.count & " Projekte."
    
    ' Schliesslich die Variablen wieder freigeben.
    ' Dies sollte beim Verlassen der Subroutine automatisch geschehen
    Set Proj = Nothing
End Sub


' TEIL: P R O J E C T S

Public Sub ExampleProjects1()
    Dim Proj As S7Project
        
    ' Lege Projekt mit Namen "Reptiles" im Standard-Verzeichnis an.
    MsgBox "Es wird nun das Projekt 'Reptiles' angelegt."
    Call S.Projects.add("Reptiles", "", S7Project)
    
    ' Ermittle das Projekt "Reptiles" und gebe einige Daten aus
    Set Proj = S.Projects("Reptiles")
    AllProjectData Proj ' Routine aus vorherigen Beispiel
End Sub


' Diese Funktion gibt True zurueck, falls ein Fehler aufgetreten ist, sonst
' false. Wird True als Parameter uebergeben, so wird der Fehler in einer
' Msg-Box gemeldet (True ist Default-Value). Die Error-Variable Err wird
' ggf. zurueckgesetzt.

Public Function CatchError(Optional msg As Boolean = True) As Boolean
    If Err.Number = 0 Then
        CatchError = False
    Else
        CatchError = True
    
        If msg Then
            MsgBox Err.Description, vbMsgBoxHelpButton, "Fehler: " _
            & Err.Number, Err.HelpFile, Err.HelpContext
        End If
        
        Err.Clear
    End If
End Function


Public Sub ExampleProjects2()
    Dim Proj As S7Project
        
    ' Versuche Projekt mit Namen "Reptiles" anzulegen
    MsgBox "Es wird nun das Projekt 'Reptiles' angelegt."
On Error Resume Next
    Call S.Projects.add("Reptiles", "", S7Project)
    CatchError
    
    ' Ermittle das Projekt "Reptiles" und gebe einige Daten aus
    Set Proj = S.Projects("Reptiles")
    If Not CatchError Then AllProjectData Proj
End Sub

Function GetTypedContainer(Collection As Object, TypeID As S7ContainerType) As Object
    Dim TmpItem As Object
    For Each TmpItem In Collection
        If TmpItem.Type = S7Container Then
            Set GetTypedContainer = TmpItem
            If GetTypedContainer.ConcreteType = TypeID Then Exit Function
        End If
    Next
    Set GetTypedContainer = Nothing
End Function

Public Sub ExampleLoad()
    Dim Prg As Object
    Dim Src As Object
    Dim Blocks As Object
    Dim Blk As Object
    Dim BlkCont As Object
    Rem Quelle aus Beispielprojekt in ein File generieren
    Set BlkCont = GetTypedContainer(S.Projects("ZDt01_08_STEP7__Mischen").Programs(1).Next, S7BlockContainer)
    BlkCont.GenerateSource "C:\Tmp\Sample222.awl"
    Rem neues Projekt mit leerem Programm erzeugen
    Set Prg = S.Projects.add("Sample222").Programs.add("Prog", S7)
    Rem leere Symboltabelle durch Symbolik des Beispielprojekts ersetzen
    Prg.SymbolTable.Remove
    S.Projects("ZDt01_08_STEP7__Mischen").Programs(1).SymbolTable.Copy Prg
    Rem Zuvor exportierte Quelle in Quellcontainer importieren
    Set Src = GetTypedContainer(Prg.Next, S7SourceContainer).Next.add("Src", S7Source, "C:\Tmp\Sample222.awl")
    Rem und 黚ersetzen
    Set Blocks = Src.Compile
    MsgBox Blocks.count & " Bausteine erzeugt"
    Rem die dabei erzeugten Bausteine auf die CPU herunterladen
    Rem dazu muss zun鋍hst sichergestellt sein, dass die CPU gestoppt ist
    On Error Resume Next 'f黵 den Fall, dass die CPU bereits gestoppt ist
    Prg.Stop
    On Error GoTo 0 'normales Fehlerhandling
    For Each Blk In Blocks
        Blk.Download (S7OverwriteAll) 'ohne weitere R點kfrage
        MsgBox Blk & " (" & Blk.SymbolicName & ") Size " & Blk.Size & " runtergeladen"
    Next

End Sub
Public Sub ExampleProjects3()
    Dim Proj As Object
    Dim Prog As Object
    Dim Prefix As String
    Rem Neues Projekt mit einem M7-Programm anlegen
On Error Resume Next
    Set Proj = S.Projects.add("Sample2161")
    Set Prog = Proj.Programs.add("Dummy", M7)
    Rem Alle Programme aus dem Beispielprojekt COM_SFB in das neue Projekt kopieren
    For Each Prog In S.Projects("ZDt01_10_STEP7__Com_SFB").Programs
        Prog.Copy Proj
    Next
    Rem Infos 黚er alle Programme des neuen Projekts ausgeben
    For Each Prog In Proj.Programs
        Prefix = ""
        If Prog.Type = S7 Then
            Prefix = "S7-"
        Else
            If Prog.Type = M7 Then
                Prefix = "M7-"
            End If
        End If
        MsgBox Prefix & "Program " & Prog & " last modified at " & Prog.Modified
    Next
End Sub

Public Sub UndoExampleProjects()
    Dim result
    
    ' Frage nach
    result = MsgBox("Soll das Projekt 'reptiles' geloescht werden?", vbYesNo, _
        "Undo Example Projects")
    If result <> vbYes Then Exit Sub
    
On Error Resume Next
    ' Loesche Project
    S.Projects.Remove ("Reptiles")
    If Not CatchError Then MsgBox "done."
End Sub


' TEIL: P R O J E C T

Public Sub AllProjectNames()
'   Gibt die Namen aller Projekte aus
    Dim Pro As S7Project
    Dim str As String
    
    str = ""
    For Each Pro In S.Projects
     str = str & Pro.Name & ", "
    Next
    
    MsgBox ("Namen aller Projekte: " & Chr(13) & str)
End Sub


Public Sub ExampleProject()
    Dim Pro As S7Project
    Dim str As String

On Error Resume Next
    ' Lege Projekt "High And Low" an.
    MsgBox ("Nun wird das Projekt High And Low angelegt.")
    Set Pro = S.Projects.add("High And Low", "c:\tmp\", S7Project)
    If CatchError Then Exit Sub
    
    ' Gebe die Namen aller Projekte und Daten von"High and Low" aus.
    Call AllProjectNames
    Call AllProjectData(Pro)
    
    ' Benenne nun "High And Low" nach "Up And Down" um
    MsgBox "Benenne 'High And Low' nach 'Up And Down' um."
    Pro.Name = "Up And Down"
    If CatchError Then Exit Sub
    
    ' Gebe nochmals alle Namen aus
    Call AllProjectNames
        
    MsgBox "done."
End Sub


' TEIL: S T A T I O N S

Public Sub AllStationNames(Pro As S7Project)
    Dim Sta As S7Station
    Dim str As String

    str = ""
    For Each Sta In Pro.Stations
        str = str & Sta.Name & ", "
    Next
    
    MsgBox ("Das Projekt " & Pro.Name & " hat folgende Stationen:" & _
            Chr(13) & str)
End Sub


Public Sub ExampleStations1()
    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
    
    ' Lege 2 neue Stationen im Projekt 'reptiles' an
    MsgBox ("Nun werden 2 Stationen im Projekt reptiles angelegt")
    Call Pro.Stations.add("relativity", S7300Station)
    If CatchError Then Exit Sub
    Call Pro.Stations.add("circlelimit", S7HStation)
    If CatchError Then Exit Sub

    ' Lege eine 3. Station mit Namen house of stairs an ...
    MsgBox ("Nun wird die Station 'house of stairs' angelegt")
    Call Pro.Stations.add("house of stairs", S7400Station)
    If CatchError Then Exit Sub
    
    ' Gebe die Namen aller Stationen des Projekts aus
    AllStationNames Pro
    
    ' ... und l鰏che sie gleich darauf wieder
    MsgBox ("L鰏che nun die Station house of staris")
    Call Pro.Stations.Remove("house of stairs")
    If CatchError Then Exit Sub
    
    ' Nochmals die Namen aller Stationen
    Call AllStationNames(Pro)
End Sub


Public Sub UndoExampleStations1()
    Dim Pro As S7Project
    Dim Sta As S7Station
    Dim result
    
On Error Resume Next
    ' Ermittle Projekt
    Set Pro = S.Projects("reptiles")
    If CatchError Then Exit Sub
    
    ' Frage nach
    result = MsgBox("Sollen alle Stationen des Projekts 'reptiles' " & _
                "geloescht werden?", vbYesNo, "Undo Example Stations 1")
    If result <> vbYes Then Exit Sub
        
    ' Loesche alle Stationen