Code:
Option Explicit'Zielpfad für den Export
Const sTargetPath As String = "C:\Temp"
'Sollen im Zielpfad existierende, gleichnamige Regeln überschrieben werden?
Const bOverwriteExisting As Boolean = False ' True = überschreiben
' False = nicht überschreiben, Export wird übersprungen
'Sollen erfolgreich exportierte Regeln deaktiviert, gelöscht oder belassen werden ?
Const iStatus As Integer = 3 ' 1 = löschen
' 2 = deaktivieren
' 3 = ignorieren
Private Sub iLogicRuleNames()
Dim oApp As Inventor.Application
Set oApp = ThisApplication
Dim oDoc As Document
Set oDoc = oApp.ActiveDocument
Dim iLogicAuto As Object
Set iLogicAuto = iLogicAddin(oApp)
If (iLogicAuto Is Nothing) Then Exit Sub
Dim oRule As Object
Dim sName As String
Dim sText As String
Dim sFailedRules As String
For Each oRule In iLogicAuto.Rules(oDoc)
sName = oRule.Name
sText = oRule.Text
If ExportRule(sName, sText) = False Then
sFailedRules = sFailedRules & vbCrLf & sName
Else
Select Case iStatus
Case 1: Call iLogicAuto.DeleteRule(oDoc, oRule.Name)
Case 2: oRule.isActive = False
Case 3:
End Select
End If
Next
If Not sFailedRules = "" Then
Call MsgBox("Der Export folgender Regeln ist fehlgeschlagen." & vbCrLf & "Die häufigste Ursache, eine gleichnamige Regel existiert bereits." & vbCrLf & sFailedRules, vbCritical, "Export Rules")
End If
End Sub
Private Function iLogicAddin(oApp As Inventor.Application) As Object
On Error GoTo NotFound
Dim oAddIn As ApplicationAddIn
Set oAddIn = oApp.ApplicationAddIns.ItemById("{3bdd8d79-2179-4b11-8a5a-257b1c0263ac}")
If (oAddIn Is Nothing) Then GoTo NotFound
If oAddIn.Activated = False Then oAddIn.Activate
Set iLogicAddin = oAddIn.Automation
Exit Function
NotFound:
End Function
Private Function ExportRule(ByVal sName As String, ByVal sText As String) As Boolean
On Error GoTo Fail
Dim oFs As FileSystemObject
Set oFs = CreateObject("Scripting.FileSystemObject")
If Not Right(sTargetPath, 1) = "\" Then sName = "\" & sName
Dim sFullFilename As String
sFullFilename = sTargetPath & sName & ".iLogicVb"
Dim oFile As TextStream
Set oFile = oFs.CreateTextFile(sFullFilename, False)
oFile.WriteLine (sText)
oFile.Close
ExportRule = True
Exit Function
Fail:
End Function