Sub Main
Trace.WriteLine("Event Driven Rules Copy", "iLogic") 'debug

 Dim oTemplateDoc As Document
 Dim oTemplate As String
 
 'check file type
 If ThisApplication.ActiveEditDocument.DocumentType = kDrawingDocumentObject Then
 'If ThisDoc.Document.DocumentType = kDrawingDocumentObject Then
  oTemplate = "cesta\název_šablony.idw"   'file to copy events from
 ElseIf ThisApplication.ActiveEditDocument.DocumentType = kPartDocumentObject Then
 'ElseIf ThisDoc.Document.DocumentType = kPartDocumentObject Then
  oTemplate = "cesta\název_šablony.ipt"   'file to copy events from
 Else
  oTemplate = "cesta\název_šablony.iam"   'file to copy events from
 End If
 
 'file to copy events to
 oInput =  ThisApplication.ActiveEditDocument.FullFileName
 If oInput = "" Then 'catch a new file with no path
  Return
 End If 
 
 'open the template
 oTemplateDoc = ThisApplication.Documents.Open(oTemplate, False)
 CopyEventsToDocuments(oTemplateDoc)
 oTemplateDoc.Close
End Sub

Private Const m_ourGuid As String = "{2C540830-0723-455E-A8E2-891722EB4C3E}"
Private savedEnabled As Boolean
Dim oInput As String

Public Sub CopyEventsToDocuments(ByVal sourceDoc As Document)
 Dim sourcePropSet As PropertySet = GetEventRulesPropertySet(sourceDoc)
 Dim inputs() As String = { oInput}
 Dim destinationFileNames As List(Of String) = New List(Of String)(inputs)
 If (destinationFileNames Is Nothing) Then Return
 savedEnabled = iLogicVb.Automation.RulesOnEventsEnabled
 iLogicVb.Automation.RulesOnEventsEnabled = False
 Try 
  CopyEventsToAllDocuments(sourcePropSet, sourceDoc, destinationFileNames)
 Finally  
  iLogicVb.Automation.RulesOnEventsEnabled = savedEnabled
 End Try

End Sub

Function GetEventRulesPropertySet(ByVal sourceDoc As Document) As PropertySet
 Try
  Return sourceDoc.PropertySets(m_ourGuid)
 Catch ex As Exception
  Return Nothing
 End Try
End Function

Function VerifyRulesPropertySet(ByVal propSet As PropertySet) As Boolean
 If (propSet Is Nothing) Then Return True
 ' See if any rules are internal instead of external.  We can't copy those.
 For Each prop As Inventor.Property In propSet
  Dim strValue As String = prop.Value.ToString
  If (Not strValue.StartsWith("file://")) Then Return False
 Next
 Return True
End Function

Sub CopyEventsToAllDocuments(ByVal sourcePropSet As PropertySet, ByVal sourceDoc As Document, ByVal destinationFileNames As List(Of String))
 For Each fileName As String In destinationFileNames
  If (String.Equals(sourceDoc.FullFileName, fileName)) Then Continue For
  CopyEventsToDocument(sourcePropSet, fileName)
 Next
End Sub

Sub CopyEventsToDocument(ByVal sourcePropSet As PropertySet, ByVal fileName As String)
 'Dim doc As Document = FindOpenDocument(fileName)

 Dim openedHere As Boolean = False

 If (doc Is Nothing) Then
  doc = ThisApplication.Documents.Open(fileName, True)
  openedHere = True
 End If
  
 CopyEventsPropertySetToDocument(sourcePropSet, doc)
 iLogicVb.Automation.RulesOnEventsEnabled = savedEnabled

End Sub

Sub CopyEventsPropertySetToDocument(ByVal sourcePropSet As PropertySet, ByVal doc As Document)
 ' If an event-driven rules property set already exists, delete it.
 Dim oldPropSet As PropertySet = GetEventRulesPropertySet(doc)
 If (oldPropSet IsNot Nothing) Then
  oldPropSet.Delete()
 End If
 If (sourcePropSet Is Nothing OrElse sourcePropSet.Count = 0) Then Return
 Dim destPropSet As PropertySet = doc.PropertySets.Add("_iLogicEventsRules", m_ourGuid)
 For Each prop As Inventor.Property In sourcePropSet
  destPropSet.Add(prop.Value, prop.Name, prop.PropId)
 Next
 EnsureDocumentInterest(doc)
End Sub

Const iLogicId As String = "{3bdd8d79-2179-4b11-8a5a-257b1c0263ac}"

Sub EnsureDocumentInterest(ByVal doc As Document)
 If (ThisApplication.SoftwareVersion.Major < 15) Then Return ' Inventor 2010 or before
 If (DocumentHasiLogicInterest(doc)) Then Return
 Dim dataVersion As Integer = 20090512
 Dim newInterest As DocumentInterest = doc.DocumentInterests.Add(iLogicId, "iLogic", DocumentInterestTypeEnum.kInterested, dataVersion, Nothing)
End Sub

Function DocumentHasiLogicInterest(ByVal doc As Document) As Boolean
 Dim interest As DocumentInterest = FindDocumentInterest(doc, iLogicId)
 If (interest IsNot Nothing) Then
  If (interest.InterestType = DocumentInterestTypeEnum.kInterested) Then
   Return True
  End If
  interest.Delete()
 End If
 Return False
End Function

Function FindDocumentInterest(ByVal doc As Document, ByVal clientId As String) As DocumentInterest
 For Each interest As DocumentInterest In doc.DocumentInterests
  If (String.Equals(interest.ClientId, clientId, StringComparison.OrdinalIgnoreCase)) Then
   Return interest
  End If
 Next
 Return Nothing
End Function

Tohle vede na to, že budete mít ten kód na desítkách až stovkách různých míst a pokud budete chtít cokoli změnit, tak to bude prakticky neproveditelné.

 

  je nějaká možnost přidat pomocí jednoho iLogic pravidla permanentně pravidlo např. pro rozvin do dílu (ipt. souboru)?

U nových dílů nemám problém, pravidlo mám v šabloně. Pro staré díly, kde toto pravidlo není aktivováno je to přes spuštěče událostí pomalé, hlavně u většího počtu dílů. Člověku prostě trvá než se prokliká nabídkou...

Měl bych představu, že bych poté dané pravidlo zahrnul do globálních formulářů a na jedno kliknutí by se rozvin natrvalo v díle aktivoval.

 

(funkční pravidlo pro rozvin mám)

 

Díky za rady.