---

Hallo zusammen

Kann mir jemand bei meinem Problem helfen?
Ich möchte eine externe iLogic Regel mit einem Makro starten

Die Vorlage zum Code habe ich aus dem Internet

Code:
Public Sub LaunchProperties_nachtragen()
  RuniLogic "Properties_nachtragen" '<------- Name anpassen
End Sub

Public Sub RuniLogic(ByVal RuleName As String)
  Dim iLogicAuto As Object
  Dim oDoc As Document

  Set oDoc = ThisApplication.ActiveDocument
  If oDoc Is Nothing Then
    MsgBox "kein Inventor Dokument vorhanden"
    Exit Sub
  End If

  Set iLogicAuto = GetiLogicAddin(ThisApplication)
  If (iLogicAuto Is Nothing) Then Exit Sub
 
  iLogicAuto.RunExternalRule oDoc, RuleName
End Sub

Function GetiLogicAddin(oApplication As Inventor.Application) As Object
  Dim addIns As ApplicationAddIns
  Set addIns = oApplication.ApplicationAddIns

  Dim addIn As ApplicationAddIn
  Dim customAddIn As ApplicationAddIn
  For Each addIn In addIns
    If (addIn.ClassIdString = "{3BDD8D79-2179-4B11-8A5A-257B1C0263AC}") Then
      Set customAddIn = addIn
    Exit For
    End If
  Next
End Function

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo noch einmal

Habe mich wahrscheinlich nicht verständlich genug ausgedrückt.
Noch mal der unten beschriebene Code habe ich aus dem Internet
es sollte funktionieren tut er aber nicht und ich habe keinen Schimmer warum.
Hat jemand eine Idee?

hier noch die externe Regel

'catch and skip errors
On Error Resume Next
'define the active assembly
Dim oAssyDoc As AssemblyDocument
oAssyDoc = ThisApplication.ActiveDocument 

'Check all referenced docs
Dim oDoc As Inventor.Document
For Each oDoc In oAssyDoc.AllReferencedDocuments

AX_A = Measure.ExtentsLength
AX_B = Measure.ExtentsWidth
AX_C = Measure.ExtentsHeight
AX_un = MinOfMany(AX_A, AX_B, AX_C)
AX_ob = MaxOfMany(AX_A, AX_B, AX_C)
AX_mi = AX_A + AX_B + AX_C - AX_un - AX_ob
iProperties.Value("Custom", "Länge") = CStr(Round(AX_ob, 1))
iProperties.Value("Custom", "Breite") = CStr(Round(AX_mi, 1))
iProperties.Value("Custom", "Höhe") = CStr(Round(AX_un, 1))'
iProperties.Value("Custom", "Dateiname")=ThisDoc.FileName(False)
iProperties.Value("Custom", "AV") = ""
iProperties.Value("Custom", "DIN") = ""
iProperties.Value("Custom","Abmessung" )= Abmessung & CStr(Round(AX_un, 1)) & " - " & CStr(Round(AX_ob, 1)) & " x " & CStr(Round(AX_mi, 1))
iProperties.Value("Custom","Werkstoff" )= Werkstoff
iProperties.Value("Custom","Werkstoff" ) = iProperties.Material
iProperties.Value("Custom", "Dateiname")=ThisDoc.FileName(False)
iProperties.Value("Custom", "Benennung1")="Blech"

Next
'update the files
InventorVb.DocumentUpdate()

Dim oAssDoc As AssemblyDocument

    oAssDoc = ThisApplication.ActiveDocument

    Dim oCompDef As AssemblyComponentDefinition

    oCompDef = oAssDoc.ComponentDefinition

    Dim oOcc As ComponentOccurrence

    For Each oOcc In oCompDef.Occurrences

    Next

'zusätzliche Properties

iProperties.Value("Custom", "Werkstoff")= iProperties.MaterialOfComponent (oOcc.Name)
iProperties.Value("Project", "Stock Number")= "=<DIN>  <Abmessung>"

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Tach

Ohne es probiert zu haben, nimm das On Error Resume Next aus der externen Regel raus und lass es laufen. Vermutlich bekommst du dann eine Fehlermeldung. Wenn das wirklich der gesamte Code ist, hängt er wahrscheinlich spätestens hier:

Code:

---

AX_A = Measure.ExtentsLength

---

EDIT:

So, hab's probiert. VBA-Code:

Code:

---

Public Sub LaunchProperties_nachtragen()
  RuniLogic "Properties_nachtragen" '<------- Name anpassen
End Sub

Public Sub RuniLogic(ByVal RuleName As String)
  Dim iLogicAuto As Object
  Dim oAssDoc As AssemblyDocument
  Dim oDoc As Document

  Set oAssDoc = ThisApplication.ActiveDocument
  If oAssDoc Is Nothing Then
    MsgBox "kein Inventor Dokument vorhanden"
    Exit Sub
  End If

  Set iLogicAuto = GetiLogicAddin(ThisApplication)
  If (iLogicAuto Is Nothing) Then Exit Sub
  For Each oDoc In oAssDoc.AllReferencedDocuments
    Call iLogicAuto.RunExternalRule(oDoc, RuleName)
  Next
End Sub

Function GetiLogicAddin(oApplication As Inventor.Application) As Object
  Dim addIns As ApplicationAddIns
  Set addIns = oApplication.ApplicationAddIns

  Dim addIn As ApplicationAddIn
  Dim customAddIn As ApplicationAddIn
  For Each addIn In addIns
    If addIn.ClassIdString = "{3BDD8D79-2179-4B11-8A5A-257B1C0263AC}" Then
      Set GetiLogicAddin = addIn.Automation
      Exit For
    End If
  Next
End Function

---

externe Regel:

Code:

---

'catch and skip errors
'On Error Resume Next
'define the active assembly
Dim oDoc As Inventor.Document
oDoc = ThisApplication.ActiveDocument

AX_A = CDbl(Measure.ExtentsLength)
AX_B = CDbl(Measure.ExtentsWidth)
AX_C = CDbl(Measure.ExtentsHeight)
AX_un = MinOfMany(AX_A, AX_B, AX_C)
AX_ob = MaxOfMany(AX_A, AX_B, AX_C)
AX_mi = AX_A + AX_B + AX_C - AX_un - AX_ob
iProperties.Value("Custom", "Länge") = CStr(Round(AX_ob,1))
iProperties.Value("Custom", "Breite") = CStr(Round(AX_mi, 1))
iProperties.Value("Custom", "Höhe") = CStr(Round(AX_un, 1))'
iProperties.Value("Custom", "Dateiname")=ThisDoc.FileName(False)
iProperties.Value("Custom", "AV") = ""
iProperties.Value("Custom", "DIN") = ""
iProperties.Value("Custom","Abmessung" )= Abmessung & CStr(Round(AX_un, 1)) & " - " & CStr(Round(AX_ob, 1)) & " x " & CStr(Round(AX_mi, 1))
iProperties.Value("Custom","Werkstoff" )= Werkstoff
iProperties.Value("Custom","Werkstoff" ) = iProperties.Material
iProperties.Value("Custom", "Dateiname")=ThisDoc.FileName(False)
iProperties.Value("Custom", "Benennung1")="Blech"

'update the files
InventorVb.DocumentUpdate()

---

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fehler.JPG

Hallo rkauskh

Habs mal so probiert läuft aber nicht.

Es sollte so funktionieren kein Plan wieso nicht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo

Bleibt er an der Stelle stehen? Fehlermeldung? Wenn er dort stehen bleibt, ist überhaupt eine Baugruppe geöffnet? Was anderes kann's an der Stelle eigentlich nicht sein.

------------------
MfG
Ralf

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo rkauskh

Habe es raus gefunden wie es geht

hier mal der Code:

Sub PropertieSchreiben()

Dim iLogicAuto As Object
Set iLogicAuto = GetiLogicAddin(ThisApplication)
If (iLogicAuto Is Nothing) Then Exit Sub

Dim doc As Document
Set doc = ThisApplication.ActiveDocument

Dim RuleName As String
RuleName = "Bezeichnungsliste"
Dim rule As Object
Set rule = iLogicAuto.GetRule(doc, "Properties nachtragen")
'If (rule Is Nothing) Then
' Call MsgBox("No rule named " & RuleName & " was found in the document.")
  'Exit Sub
'End If

Dim i As Integer
i = iLogicAuto.RunExternalRule(doc, "Properties nachtragen")

End Sub

Function GetiLogicAddin(oApplication As Inventor.Application) As Object
Dim addIns As ApplicationAddIns
Set addIns = oApplication.ApplicationAddIns

Dim addIn As ApplicationAddIn
On Error GoTo NotFound
Set addIn = oApplication.ApplicationAddIns.ItemById("{3bdd8d79-2179-4b11-8a5a-257b1c0263ac}")

If (addIn Is Nothing) Then Exit Function

addIn.Activate
Set GetiLogicAddin = addIn.Automation
Exit Function
NotFound:
End Function

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP