Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  iproperties der Einzelteile in einer Baugruppe ändern

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   iproperties der Einzelteile in einer Baugruppe ändern (676 mal gelesen)
Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 03. Aug. 2020 20:01    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

ich habe ein Makro geschrieben das die Kategorie in den iproperties ändert. Es wird zb. KT für Kaufteil oder Bauteil für Fertigungsteile eingetragen. Dies ist abhängig vom Speicherort oder von dem Dateityp. Jetzt suche ich nach einer Lösung das ich das Makro in einer Baugruppe starte und das auf alle Unterbaugruppen und Teile das Makro angewendet wird. Es wäre gut wenn dazu nicht die Unterbaugruppen und Teile geöffnet werden.

Anbei mein jetziger Code um die Kategorie festzulegen.

Code:

Public Sub Kategorie()

Dim Pfad As String
Dim Kategorie As String

Dim Ergebniss_Kaufteil As String
Dim Ergebniss_Werkstück As String

If ThisApplication.ActiveDocument.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then

Pfad = ThisApplication.ActiveDocument.FullFileName

Ergebniss_Kaufteil = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist
Ergebniss_Werkstück = InStr(1, Pfad, "Werkstück", vbTextCompare) 'prüfen ob Werkstück im Dateipfad vorhanden ist

Kategorie = "0"

If Kategorie = "0" And Ergebniss_Kaufteil > 1 Then
    Kategorie = "K"
End If

If Kategorie = "0" And Ergebniss_Werkstück > 1 Then
    Kategorie = "W"
End If

If Kategorie = "0" And ThisApplication.ActiveDocument.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then
    Kategorie = "S" 'Schweißbaugruppe
End If


If Kategorie = "0" And ThisApplication.ActiveDocument.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Then
   Kategorie = "BG" 'Baugruppe
End If

If Kategorie = "0" And ThisApplication.ActiveDocument.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then
    Kategorie = "Bauteil" 'Bauteil
End If

If Kategorie = "0" And ThisApplication.ActiveDocument.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then
    Kategorie = "Blechteil" 'Blechteil
End If

ThisApplication.ActiveDocument.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie

End If

MsgBox "Kategorie = " & ThisApplication.ActiveDocument.PropertySets("Inventor Document Summary Information").Item("Category").Value

End Sub



Vielen Dank

Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1632
Registriert: 15.11.2006

Windows 10 x64, Inventor 2020

erstellt am: 03. Aug. 2020 23:45    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo

Benutz bitte zukünftig die Code-Tags wenn du Code postest. Das macht das Lesen sehr viel einfacher. Ich hab das mal geändert.
Wenn du Kategorie auf "0" setzt, brauchst du es nicht als Prüfmerkmal verwenden, da es keinen anderen Wert haben wird. Aufgrund besserer Lesbarkeit würde ich statt der vielen IF-Abfragen eher zu einem Select case tendieren.
Mit VBA wirst du das Problem nicht verhindern, dass Inventor die Dateien alle öffnet. Wenn Geschwindigkeit und/oder Arbeitsspeichermangel hier ein Problem sind, musst du dich mit dem Erstellen eines .Net-Programms dass den Apprenticeserver verwendet auseinandersetzen.
Zu deiner Frage, die AllReferencedDocuments beinhalten alle referenzierten Dokumente einer Baugruppe, egal in welcher Ebene.
Hier ein Beispiel für den Zugriff darauf.

Code:

Public Sub ShowReferencedDocuments()
    Dim oAssDoc As AssemblyDocument
    Set oAssDoc = ThisApplication.ActiveDocument

    Dim oRefedDocs As DocumentsEnumerator
    Set oRefedDocs = oAssDoc.AllReferencedDocuments

    Dim oRefedDoc As Document
    For Each oRefedDoc In oRefedDocs
        ' hier der Aufruf deines Codes
        Call Kategorie(oRefedDoc)
    Next
End Sub

Public Sub Kategorie(byVal oRefedDoc as Document)
'....
'eigenen Code entsprechend anpassen, dass oRefedDoc verwendet wird
End Sub


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

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 04. Aug. 2020 08:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo zusammen,

@rkauskh

Ich habe mir mal select case angeschaut und konnte das nicht auf Thomas Beispiel übertragen. Select Case fasst ja (vereinfacht gesagt) mehrere Eigenschaften / Werte zu einem Fall zusammen.

Bsp. Eigenschaft Apfel, Birne, Pfirsich -> Fall Obst (Kalaueralarm)

Thomas vergleicht aber doch das gleichzeitige Vorhandensein zweier Eigenschaften

Eigenschaft Apfel und Eigenschaft grün -> unreifes Früchtchen

Wie würdest du das in select case abbilden? Bzw. wie würde das den Code verkürzen?

Ich hätte eine geschachtelte If Then Anweisung gemacht und das Ganze ggf. noch in eine Funktion verpackt:

Code:

Function KategorieZuweisung()

If Kategorie = "0" Then

If Ergebniss_Kaufteil > 1 Then
Kategorie = "K"

ElseIf Ergebniss_Werkstück > 1 Then
Kategorie = "W"

ElseIf ThisApplication.ActiveDocument.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then
Kategorie = "S" 'Schweißbaugruppe
....

End If

End If

KategorieZuweisung = Kategorie

End Function


Stehe ich da auf dem Schlauch?


Grüße

EIBe 3D


BTW. Wieso ist der Code nicht eingerückt?

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1632
Registriert: 15.11.2006

Windows 10 x64, Inventor 2020

erstellt am: 04. Aug. 2020 12:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo

Das Kategorie aus den Abfragen entfernt werden kann, da es direkt vorab auf 0 gesetzt wird, hatte ich ja schon gesagt. Das Select case würde ich für den SubType verwenden. Sieht in meinen Augen besser lesbar aus.

Code:

Public Sub ShowReferencedDocuments()
    Dim oAssDoc As AssemblyDocument
    Set oAssDoc = ThisApplication.ActiveDocument
   
    Dim oRefedDoc As Document
   
    For Each oRefedDoc In oAssDoc.AllReferencedDocuments
        Call Kategorie(oRefedDoc)
    Next
End Sub

Private Sub Kategorie(ByVal oRefedDoc As Document)

Dim Pfad, Kategorie As String
Pfad = oRefedDoc.FullFileName

If oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
    If InStr(1, Pfad, "Kaufteil", vbTextCompare) > 1 Then Kategorie = "K"       'prüfen ob Kaufteil im Dateipfad vorhanden ist
    If InStr(1, Pfad, "Werkstück", vbTextCompare) > 1 Then Kategorie = "W"      'prüfen ob Werkstück im Dateipfad vorhanden ist
   
    Select Case oRefedDoc.SubType
        Case "{28EC8354-9024-440F-A8A2-0E0E55D635B0}": Kategorie = "S"          'Schweißbaugruppe
        Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}": Kategorie = "BG"         'Baugruppe
        Case "{4D29B490-49B2-11D0-93C3-7E0706000000}": Kategorie = "Bauteil"    'Bauteil
        Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}": Kategorie = "Blechteil"  'Blechteil
    End Select

    oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie
End If

End Sub


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

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 04. Aug. 2020 14:45    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von rkauskh:
...
Das Kategorie aus den Abfragen entfernt werden kann, da es direkt vorab auf 0 gesetzt wird, hatte ich ja schon gesagt.
...

Ok, das hatte ich gekonnt übersehen 


Und ja, dein Code ist deutlich übersichtlicher. Danke für das Beispiel, ich werde es bei Bedarf umsetzen.


Grüße

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 04. Aug. 2020 20:39    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

vielen Dank für eure Antworten. Ich konnte die Aufgabe damit lösen.

Grüße Thomas

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 11. Aug. 2020 19:17    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

bei der Anwendung des Makros ist jetzt das Problem aufgetreten das virtuelle Komponenten nicht berücksichtigt werden (Kategorie wird nicht ausgefüllt). Gibt es eine Möglichkeit die Kategorie von virtuellen Komponenten mittels Makro auszufüllen?

Vielen Dank Voraus

Grüße Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1632
Registriert: 15.11.2006

Windows 10 x64, Inventor 2020

erstellt am: 11. Aug. 2020 22:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo

Ja, gibt es.
Man muss nur rekursiv durch die Occurrences und bei Unterbaugruppen eine Ebene tiefer tauchen und bei virtuellen Bauteilen irgendwas machen. Ich hab jetzt mal unterstellt, in Kategorie soll "V" eingetragen werden.
Hab's nicht getestet, sollte aber laufen. Hoffentlich. 

Code:

Option Explicit

Public Sub ShowReferencedDocuments()
   
    Dim oAssDoc As AssemblyDocument
    Set oAssDoc = ThisApplication.ActiveDocument
   
    Dim oRefedDoc As Document
   
    For Each oRefedDoc In oAssDoc.AllReferencedDocuments
        Call Kategorie(oRefedDoc)
    Next
   
    Dim oOcc As ComponentOccurrence
   
    For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call ProcessAllOccs(oOcc)
        ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
            If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
            End If
        End If
    Next
   
End Sub

Private Sub Kategorie(ByVal oRefedDoc As Document)

Dim Pfad, Kategorie As String
Pfad = oRefedDoc.FullFileName

If oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
    If InStr(1, Pfad, "Kaufteil", vbTextCompare) > 1 Then Kategorie = "K"      'prüfen ob Kaufteil im Dateipfad vorhanden ist
    If InStr(1, Pfad, "Werkstück", vbTextCompare) > 1 Then Kategorie = "W"      'prüfen ob Werkstück im Dateipfad vorhanden ist
   
    Select Case oRefedDoc.SubType
        Case "{28EC8354-9024-440F-A8A2-0E0E55D635B0}": Kategorie = "S"          'Schweißbaugruppe
        Case "{E60F81E1-49B3-11D0-93C3-7E0706000000}": Kategorie = "BG"        'Baugruppe
        Case "{4D29B490-49B2-11D0-93C3-7E0706000000}": Kategorie = "Bauteil"    'Bauteil
        Case "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}": Kategorie = "Blechteil"  'Blechteil
    End Select

    oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie
End If

End Sub

Private Sub ProcessAllOccs(ByVal oSubOcc As ComponentOccurrence)
   
    Dim oOcc As ComponentOccurrence
   
    For Each oOcc In oSubOcc
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call ProcessAllOccs(oOcc)
        ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
            If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
            End If
        End If
    Next
   
End Sub



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

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 12. Aug. 2020 11:47    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Ralf,

vielen Dank für die schnelle Antwort.

bei der folgenden Zeile bekomme ich eine Fehlermeldung (run-time error '438') bzw. sieht mein ursprugsmakro inzwischen wie olgt aus.

For Each oOcc In oSubOcc

Danke und Grüße Thomas


Code:
Public Sub Kategorie()
   
    Dim oAssDoc As AssemblyDocument
    Dim oRefedDoc As Document
   
   
   
If ThisApplication.ActiveDocument.SubType = "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then 'Zeichnung -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
       
  MsgBox ("Makro wird nicht bei einer Zeichnung angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
       
Else
       
    'keine Eintrag, Programm läuft weiter

End If


If ThisApplication.ActiveDocument.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then 'Bauteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
       
  MsgBox ("Makro wird nicht bei einem Bauteil angewendet, bitte eine Baugruppe öffnen")
  'Set oRefedDoc = ThisApplication.ActiveDocument
 
  Exit Sub
       
Else
       
    'keine Eintrag, Programm läuft weiter
   
   

End If


If ThisApplication.ActiveDocument.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 'Blechteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
       
  MsgBox ("Makro wird nicht bei einem Blechteil angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
       
Else
       
    'keine Eintrag, Programm läuft weiter

End If


    Set oAssDoc = ThisApplication.ActiveDocument
    Dim oRefedDocs As DocumentsEnumerator
    Set oRefedDocs = oAssDoc.AllReferencedDocuments
 
 
  Dim oOcc As ComponentOccurrence 'Test vir
 
 
    For Each oRefedDoc In oRefedDocs
        ' hier der Aufruf deines Codes -> sprung in die Funktion Public Sub Kategorie(ByVal oRefedDoc As Document)
        Call Kategorie_schreiben(oRefedDoc)
  Next
       
   
'---- Test virtuelle Komponenten
   
        For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call ProcessAllOccs(oOcc)
        ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
            If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
            End If
        End If
    Next
   
'----
   
    Set oRefedDoc = ThisApplication.ActiveDocument 'in akt. Baugruppe Kategorie Festlegen
   
    Call Kategorie_schreiben(oRefedDoc)
   
   
    MsgBox "Kategorien in den Bauteilen und Baugruppen eingetragen"
   
End Sub

Sub Kategorie_schreiben(ByVal oRefedDoc As Document)
'eigenen Code entsprechend anpassen, dass oRefedDoc verwendet wird -> ThisApplication.ActiveDocument wurde ersetzt 04.08.2020 TE

Dim Pfad As String
Dim Kategorie As String

Dim Ergebniss_Kaufteil As String
Dim Ergebniss_Werkstück As String
Dim Ergebniss_Normteil As String


Pfad = oRefedDoc.FullFileName

'folgend -> Prüfung wenn Teil unter Normteile gespeichert ist -> es erfolgt keine Eintragung der Kategorie

Ergebniss_Normteil = InStr(1, Pfad, "Normteile", vbTextCompare) 'prüfen ob Norm im Dateipfad vorhanden ist

If Ergebniss_Normteil > 1 Then

  Exit Sub 'Abbruch wenn das Teil ein Normteil ist
 
End If
   

'If oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then

Ergebniss_Kaufteil = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist
Ergebniss_Werkstück = InStr(1, Pfad, "Werkstück", vbTextCompare) 'prüfen ob Werkstück im Dateipfad vorhanden ist

Kategorie = "0"

If Kategorie = "0" And Ergebniss_Kaufteil > 1 Then

    Kategorie = "K"
   
End If


If Kategorie = "0" And Ergebniss_Werkstück > 1 Then

    Kategorie = "W"
     
End If

If Kategorie = "0" And oRefedDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then

    Kategorie = "S" 'Schweißbaugruppe
   
End If


If Kategorie = "0" And oRefedDoc.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Then

  Kategorie = "A" 'Baugruppe

End If


If Kategorie = "0" And oRefedDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then
   
    Kategorie = "F" 'Bauteil

End If

If Kategorie = "0" And oRefedDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then

    Kategorie = "F" 'Blechteil

End If


If Kategorie = oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value Then ' Kategorie nur überschreiben wenn eine Änderung festgestellt wurde

    Exit Sub ' Programmende wenn keine Änderung vorgenommen werden muss

Else

    oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie

End If


'End If

'MsgBox "Kategorie = " & oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value


End Sub

  Private Sub ProcessAllOccs(ByVal oSubOcc As ComponentOccurrence)
     
        Dim oOcc As ComponentOccurrence
     
        For Each oOcc In oSubOcc '-> fehler Zeile
            If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
                Call ProcessAllOccs(oOcc)
            ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
                If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                    oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
                End If
            End If
        Next
     
    End Sub


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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 13. Aug. 2020 08:51    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Code:
For Each oOcc In oSubOcc.Definition.Occurrences

Sollte dann klappen

Gruß

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 13. Aug. 2020 09:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Elbe 3D,

vielen Dank für deine Antwort, ich hab das gleich mal probirert es funktioniert aber nicht, jetzt kommt ein Fehler bei der nächsten Zeile.

If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then


Fehlermeldung:

Run-time error '-2147467259 (800004005)':

Methode 'definition' of objekt 'componentOccurrence' failed

Grüße Thomas

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 13. Aug. 2020 09:37    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo Thomas,

bei mir in meiner TestBG mit 2 Ebene tief geschachtelten UBGs und einer Schweißbaugruppe läuft dein Code mit oben genannter Korrektur fehlerfrei durch.

Kann dir da leider nicht weiterhelfen. Evtl. kannst du ein Pack and Go von einer Testbaugruppe mit Ordnerstruktur machen und hochladen?


Grüße

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 13. Aug. 2020 10:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Elbe 3D,

ok ich habe jetzt noch mal eine neue Testbaugruppe erstellt, mit dieser funktioniert es. Es gibt Baugruppen mit den geht es und mit manchen nicht, das ist doch aber auch komisch.

Hast du vielleicht eine Idee woran das liegen könnte.

Grüße Thomas

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 13. Aug. 2020 11:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Du wirst in den Fehlerbaugruppen eine Occurence haben bei der .Definition nicht greift, da vermutlich nicht vorhanden.

Nimm eine BG in welcher der Fehler auftritt und schau dir die Occurence im Lokal Fenster an (Ansicht -> Lokal Feanster)

Ansonsten kann ich da im Moment ohne fehlerhafte BG nicht weiterhelfen


Grüße

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 13. Aug. 2020 13:17    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Was ich bei Ansicht -> Lokal Fester nachsehen soll versteh ich nicht, kannst du dies bitte noch mal näher beschreiben?

Grüße und vielen Dank für die Hilfe

Thomas

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 13. Aug. 2020 14:34    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich


Occ_untersuchen.png

 
sieh mal in den Screenshot

in dem Fall wenn du die Fehlermeldung bekommst wird der Code eine Zeile über der markierten angehalten.

Dann kannst du schauen bei welcher oOcc der Code crasht und weißt welche Datei den Fehler auslöst. Diese hat mutmaßlich nicht, wei blau markiert Definiton dort stehen, weshalb die der Code dann eben auch nichts machen kann.


Gruß

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 13. Aug. 2020 15:23    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Occ_definition.JPG

 
Danke,

anbei mein Screenshot, ich kann damit aber leider nichts anfangen.

Grüße Thomas

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 13. Aug. 2020 15:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Mir scheint da ein / mehrere fehlerhafte(s) Teil in deiner BG zu stecken.

Wenn du in deinem Screeshot etwas hochscrollst, kannst du den DisplayName lesen und das Teil in deiner BG identifizieren. So weißt du wenigstens welches Teil den Fehler verursacht.

Was und wieso es defekt ist kann ich dir aus der Ferne ohne die entsprechende Datei auch nicht sagen.

Grüße

EIBe 3D

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

RolandD
Mitglied



Sehen Sie sich das Profil von RolandD an!   Senden Sie eine Private Message an RolandD  Schreiben Sie einen Gästebucheintrag für RolandD

Beiträge: 456
Registriert: 07.01.2005

i7-9700k
32GB DDR4-RAM
Nvidia RTX 2060
SSD 970 m.2
Win10-64 (1909)
AIP 2020.3
Dell U3417W

erstellt am: 13. Aug. 2020 18:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hast du in den Baugruppen mit dem Fehler LODs (Level of Detail, also Teile unterdrückt)?

------------------
Gruß Roland

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 13. Aug. 2020 19:56    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

in einer Unterbaugruppe war eine Ersatzdetailgenauigkeit (vereinfachtes Modell) abgelegt. Die Ersatzdetailgenauigkeit war aber nicht mehr vorhanden. Nach dem Löschen der Ersatzdetailgenauigkeit in der Baugruppe lief das Makro durch.

Ist es Möglich den Fehler abzufragen das man einen Hinweis geben kann wo der Fehler liegt (Bauteil von Ersatzdetailgenauigkeit nicht gefunden).

Noch mal vielen Dank für Eure bisherige Hilfe das ist echt super.

Grüße Thomas

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 11. Sep. 2020 09:54    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

ich möchte mein vorhandenes Makro anpassen und suche nach einem Ansatz wie ich dies umsetzen kann. Die Kaufteilbaugruppen sollen ein „K“ bekommen und die Einzelteile von der Kaufteilbaugruppe ein „KE“. Hat Dazu jemand eine Idee?

Code:
'erstellt: TE
'Datum: 04.08.2020
'Programmteil Public Sub ShowReferencedDocuments() über ww3.CAD.de erfragt -> Thema: iproperties der Einzelteile in einer Baugruppe ändern

Public Sub Kategorie()
 
    Dim oAssDoc As AssemblyDocument
    Dim oRefedDoc As Document
 
 
 
If ThisApplication.ActiveDocument.SubType = "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then 'Zeichnung -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
     
  MsgBox ("Makro wird nicht bei einer Zeichnung angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
     
Else
     
    'keine Eintrag, Programm läuft weiter

End If


If ThisApplication.ActiveDocument.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then 'Bauteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
     
  MsgBox ("Makro wird nicht bei einem Bauteil angewendet, bitte eine Baugruppe öffnen")
  'Set oRefedDoc = ThisApplication.ActiveDocument

  Exit Sub
     
Else
     
    'keine Eintrag, Programm läuft weiter
 
 

End If


If ThisApplication.ActiveDocument.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 'Blechteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
     
  MsgBox ("Makro wird nicht bei einem Blechteil angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
     
Else
     
    'keine Eintrag, Programm läuft weiter

End If


    Set oAssDoc = ThisApplication.ActiveDocument
    Dim oRefedDocs As DocumentsEnumerator
    Set oRefedDocs = oAssDoc.AllReferencedDocuments


  Dim oOcc As ComponentOccurrence 'Test vir


    For Each oRefedDoc In oRefedDocs
        ' hier der Aufruf deines Codes -> sprung in die Funktion Public Sub Kategorie(ByVal oRefedDoc As Document)
        Call Kategorie_schreiben(oRefedDoc)
  Next
     
 
'---- Test virtuelle Komponenten
 
        For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call ProcessAllOccs(oOcc)
        ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
            If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
            End If
        End If
    Next
 
'----
 
    Set oRefedDoc = ThisApplication.ActiveDocument 'in akt. Baugruppe Kategorie Festlegen
 
    Call Kategorie_schreiben(oRefedDoc)
 
 
    MsgBox "Kategorien in den Bauteilen und Baugruppen eingetragen"
 
End Sub

Sub Kategorie_schreiben(ByVal oRefedDoc As Document)
'eigenen Code entsprechend anpassen, dass oRefedDoc verwendet wird -> ThisApplication.ActiveDocument wurde ersetzt 04.08.2020 TE

Dim Pfad As String
Dim Kategorie As String

Dim Ergebniss_Kaufteil As String
Dim Ergebniss_Werkstück As String
Dim Ergebniss_Normteil As String


Pfad = oRefedDoc.FullFileName

'folgend -> Prüfung wenn Teil unter Normteile gespeichert ist -> es erfolgt keine Eintragung der Kategorie

Ergebniss_Normteil = InStr(1, Pfad, "Normteile", vbTextCompare) 'prüfen ob Norm im Dateipfad vorhanden ist

If Ergebniss_Normteil > 1 Then

  Exit Sub 'Abbruch wenn das Teil ein Normteil ist

End If
 

'If oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then

Ergebniss_Kaufteil = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist
Ergebniss_Werkstück = InStr(1, Pfad, "Werkstück", vbTextCompare) 'prüfen ob Werkstück im Dateipfad vorhanden ist

Kategorie = "0"

If Kategorie = "0" And Ergebniss_Kaufteil > 1 Then

    Kategorie = "K"
 
End If


If Kategorie = "0" And Ergebniss_Werkstück > 1 Then

    Kategorie = "W"
   
End If

If Kategorie = "0" And oRefedDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then

    Kategorie = "S" 'Schweißbaugruppe
 
End If


If Kategorie = "0" And oRefedDoc.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Then

  Kategorie = "A" 'Baugruppe

End If


If Kategorie = "0" And oRefedDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then
 
    Kategorie = "F" 'Bauteil

End If

If Kategorie = "0" And oRefedDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then

    Kategorie = "F" 'Blechteil

End If


If Kategorie = oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value Then ' Kategorie nur überschreiben wenn eine Änderung festgestellt wurde

    Exit Sub ' Programmende wenn keine Änderung vorgenommen werden muss

Else

    oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie

End If


'End If

'MsgBox "Kategorie = " & oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value


End Sub

  Private Sub ProcessAllOccs(ByVal oSubOcc As ComponentOccurrence)
   
        Dim oOcc As ComponentOccurrence
   
        For Each oOcc In oSubOcc.Definition.Occurrences 'For Each oOcc In oSubOcc '-> fehler Zeile
            If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
                Call ProcessAllOccs(oOcc)
            ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
                If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                    oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
                End If
            End If
        Next
   
    End Sub


Grüße Thomas

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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 11. Sep. 2020 11:21    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo Thomas,

vielleicht darf ich dir als erstes ans Herz legen deinen Code aufzuräumen und zu verkürzen.

Bspw.

Code:
Public Sub Kategorie()

    Dim oAssDoc As AssemblyDocument
    Dim oRefedDoc As Document



If ThisApplication.ActiveDocument.SubType = "{BBF9FDF1-52DC-11D0-8C04-0800090BE8EC}" Then 'Zeichnung -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
    
  MsgBox ("Makro wird nicht bei einer Zeichnung angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
    
Else
    
    'keine Eintrag, Programm läuft weiter

End If


If ThisApplication.ActiveDocument.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then 'Bauteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
    
  MsgBox ("Makro wird nicht bei einem Bauteil angewendet, bitte eine Baugruppe öffnen")
  'Set oRefedDoc = ThisApplication.ActiveDocument

  Exit Sub
    
Else
    
    'keine Eintrag, Programm läuft weiter

End If


If ThisApplication.ActiveDocument.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then 'Blechteil -> Abfrage das eine Zeichnung oder bauteil geöfnet sein muss
    
  MsgBox ("Makro wird nicht bei einem Blechteil angewendet, bitte eine Baugruppe öffnen")
  Exit Sub
    
Else
    
    'keine Eintrag, Programm läuft weiter

End If


Ist eigentlich vollständig mit untigen abgedeckt, wenn du keinen Wert darauf legst dem Anwender nochmals zu sagen in welchem Dokumenttyp er sich befindet.

Code:

Public Sub Kategorie()

Dim oApp As Inventor.Application: Set oApp = ThisApplication

Dim oDoc As Inventor.Document: Set oDoc = oApp.ActiveDocument

Dim oDocDType As DocumentTypeEnum: oDocDType = oDoc.DocumentType

Dim sDialogTitle As String: sDialogTitle = "Makro Kategorien schreiben"


If oDocType <> kAssemblyDocumentObject Then
    MsgBox "Diese Makro lässt sich nur in Baugruppen verwenden!" & vbCr & _
            "Bitte eine Baugruppe öffnen", vbExclamation, sDialogTitle
    Exit Sub
End If
...



Ansonsten sollte es mit folgenden Anpassungen funktionieren:

Code:
...
'ändern:
'Dim Ergebniss_Kaufteil As String
'zu:
Dim Ergebniss_Kaufteil As Long

'Hinzu
Dim Ergebniss_Kaufen As Long
Dim Ergebniss_KaufBG As Long

'ändern:
'Ergebniss_Kaufteil = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist
'zu:
Ergebniss_Kaufen = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist

'Hinzu
If Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_KaufBG = 2
ElseIf Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_Kaufteil = 2
End If


If Kategorie = "0" And Ergebniss_Kaufteil > 1 Then
    Kategorie = "KE"
If Kategorie = "0" And Ergebniss_KaufBG > 1 Then
    Kategorie = "K"
End If
....


BTW
Das Ergebnis, die Ergebnisse  

Wie oben schon geschrieben und in dem Thread von rkauskh erwähnt -> gestalte deinen Code etwas übersichtlicher und kürzer. Vor dir machst du es damit leichter.


Grüße

EIBe 3D

[Diese Nachricht wurde von EIBe 3D am 11. Sep. 2020 editiert.]

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 11. Sep. 2020 12:28    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

vielen Dank für die schnelle Antwort. Ich habe dies auch gleich probiert. Wenn ich den ersten Teil erstetze (Code vereinfache) bekomme ich den Fehler das eine Baugruppe geöffnet werden soll obwohl eine geöffnet ist.

Bei dem zweiten Teil ist das Problem das es in die Einzelteile vom Kaufteil ein "F" schreibt anstatt ein "KE".

Habe ich was beim ersetzen/ einfügen vergessen oder falsch verstanden?

Code:
Public Sub Kategorie()

Dim oApp As Inventor.Application: Set oApp = ThisApplication

Dim oDoc As Inventor.Document: Set oDoc = oApp.ActiveDocument

Dim oDocDType As DocumentTypeEnum: oDocDType = oDoc.DocumentType

Dim sDialogTitle As String: sDialogTitle = "Makro Kategorien schreiben"


If oDocType <> kAssemblyDocumentObject Then
    MsgBox "Diese Makro lässt sich nur in Baugruppen verwenden!" & vbCr & _
            "Bitte eine Baugruppe öffnen", vbExclamation, sDialogTitle
    Exit Sub
End If


    Set oAssDoc = ThisApplication.ActiveDocument
    Dim oRefedDocs As DocumentsEnumerator
    Set oRefedDocs = oAssDoc.AllReferencedDocuments


  Dim oOcc As ComponentOccurrence 'Test vir


    For Each oRefedDoc In oRefedDocs
        ' hier der Aufruf deines Codes -> sprung in die Funktion Public Sub Kategorie(ByVal oRefedDoc As Document)
        Call Kategorie_schreiben(oRefedDoc)
  Next
   

'---- Test virtuelle Komponenten

        For Each oOcc In oAssDoc.ComponentDefinition.Occurrences
        If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
            Call ProcessAllOccs(oOcc)
        ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
            If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
            End If
        End If
    Next

'----

    Set oRefedDoc = ThisApplication.ActiveDocument 'in akt. Baugruppe Kategorie Festlegen

    Call Kategorie_schreiben(oRefedDoc)


    MsgBox "Kategorien in den Bauteilen und Baugruppen eingetragen"

End Sub

Sub Kategorie_schreiben(ByVal oRefedDoc As Document)
'eigenen Code entsprechend anpassen, dass oRefedDoc verwendet wird -> ThisApplication.ActiveDocument wurde ersetzt 04.08.2020 TE

Dim Pfad As String
Dim Kategorie As String

Dim Ergebniss_Kaufteil As Long
Dim Ergebniss_Werkstück As String
Dim Ergebniss_Normteil As String

Dim Ergebniss_Kaufen As Long
Dim Ergebniss_KaufBG As Long


Pfad = oRefedDoc.FullFileName

'folgend -> Prüfung wenn Teil unter Normteile gespeichert ist -> es erfolgt keine Eintragung der Kategorie

Ergebniss_Normteil = InStr(1, Pfad, "Normteile", vbTextCompare) 'prüfen ob Norm im Dateipfad vorhanden ist

If Ergebniss_Normteil > 1 Then

  Exit Sub 'Abbruch wenn das Teil ein Normteil ist

End If

'If oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then

Ergebniss_Kaufen = InStr(1, Pfad, "Kaufteil", vbTextCompare) 'prüfen ob Kaufteil im Dateipfad vorhanden ist
Ergebniss_Werkstück = InStr(1, Pfad, "Werkstück", vbTextCompare) 'prüfen ob Werkstück im Dateipfad vorhanden ist

Kategorie = "0"

If Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_KaufBG = 2
ElseIf Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_Kaufteil = 2
End If


If Kategorie = "0" And Ergebniss_Kaufteil > 1 Then
    Kategorie = "KE"
End If
If Kategorie = "0" And Ergebniss_KaufBG > 1 Then
    Kategorie = "K"
End If


If Kategorie = "0" And Ergebniss_Werkstück > 1 Then

    Kategorie = "W"
 
End If

If Kategorie = "0" And oRefedDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then

    Kategorie = "S" 'Schweißbaugruppe

End If


If Kategorie = "0" And oRefedDoc.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Then

  Kategorie = "A" 'Baugruppe

End If


If Kategorie = "0" And oRefedDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then

    Kategorie = "F" 'Bauteil

End If

If Kategorie = "0" And oRefedDoc.SubType = "{9C464203-9BAE-11D3-8BAD-0060B0CE6BB4}" Then

    Kategorie = "F" 'Blechteil

End If


If Kategorie = oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value Then ' Kategorie nur überschreiben wenn eine Änderung festgestellt wurde

    Exit Sub ' Programmende wenn keine Änderung vorgenommen werden muss

Else

    oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value = Kategorie

End If


'End If

'MsgBox "Kategorie = " & oRefedDoc.PropertySets("Inventor Document Summary Information").Item("Category").Value


End Sub

  Private Sub ProcessAllOccs(ByVal oSubOcc As ComponentOccurrence)
 
        Dim oOcc As ComponentOccurrence
 
        For Each oOcc In oSubOcc.Definition.Occurrences 'For Each oOcc In oSubOcc '-> fehler Zeile
            If oOcc.Definition.Type = kAssemblyComponentDefinitionObject Then
                Call ProcessAllOccs(oOcc)
            ElseIf oOcc.Definition.Type = kVirtualComponentDefinitionObject Then
                If oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "" Then
                    oOcc.Definition.PropertySets("Inventor Document Summary Information").Item("Category").Value = "V"
                End If
            End If
        Next
 
    End Sub


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

EIBe 3D
Mitglied
Dipl. - Ing. (FH)


Sehen Sie sich das Profil von EIBe 3D an!   Senden Sie eine Private Message an EIBe 3D  Schreiben Sie einen Gästebucheintrag für EIBe 3D

Beiträge: 65
Registriert: 24.01.2020

HP Z4 G4 Workstation
Xeon 3,6 32GB
Nvidia P2000
WIN10
SW2015 SP5.0
SW2017
*************
Inv2018 akt.SP

erstellt am: 11. Sep. 2020 13:13    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Sorry Tippfehler

If oDocType <> kAssemblyDocumentObject Then

->
If oDocDType <> kAssemblyDocumentObject Then

....

Du überschreibst die Kategorie hier wieder wenn Bauteil

If Kategorie = "0" And oRefedDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then

    Kategorie = "F" 'Bauteil

End If

Dies sollte es vermeiden

If Ergebniss_Kaufen = 0 Then
If Kategorie = "0" And oRefedDoc.SubType = "{4D29B490-49B2-11D0-93C3-7E0706000000}" Then

    Kategorie = "F" 'Bauteil

End If
End If


Vielleicht solltest du auch deine If Kategorie = "0" überdenken


zB

If Kategorie = "0" Then

If Ergebniss_Werkstück > 1 Then
    Kategorie = "W"
ElseIf RefedDoc.SubType = "{28EC8354-9024-440F-A8A2-0E0E55D635B0}" Then
    Kategorie = "S" 'Schweißbaugruppe
ElseIf oRefedDoc.SubType = "{E60F81E1-49B3-11D0-93C3-7E0706000000}" Then
  Kategorie = "A" 'Baugruppe
...
End If

Aber zur Kategorie = 0 Geschichte hatte rkauskh weiter oben schon etwas geschrieben


Grüße

EIBe 3D

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 11. Sep. 2020 14:07    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

die erste Änderung funktioniert, Danke

Bei der zweiten Änderung ist es jetzt so das in das Einzelteil eine "0" eingetragen wird.

Sind die folgenden Zeilen richtig?

Code:
If Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_KaufBG = 2
ElseIf Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_Kaufteil = 2
End If
 

Grüße Thomas

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 11. Sep. 2020 19:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

ich habe folgende Zeilen angepasst (bei dem Elself Zweig kAssemblyDocumentObject geändert in kPartDocumentObject)

Code:
If Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kAssemblyDocumentObject Then
    Ergebniss_KaufBG = 2
ElseIf Ergebniss_Kaufen > 1 And oRefedDoc.DocumentType = kPartDocumentObject Then
    Ergebniss_Kaufteil = 2
End If

Das funktioniert jetzt aber ich glaube ich habe mich bei der Problem Beschreibung nicht richtig ausgedrückt.

Fall 1:

Kaufteilbaugruppe mit Einzelteilen (Kaufteil im Dateipfad):

- Baugruppe (.iam) -> "K"
- Einzelteile der Baugruppe (.ipt)-> KE

Fall 2:

Kaufteil Einzelteil (Kaufteil im Dateipfad):

- Einzelteile (.ipt) -> "K"

Dazu müsste man ja prüfen welche Einzelteile in der Baugruppe verbaut sind, oder? Ist die Information in der Baugruppe aus lesbar?

Der Grund ist das in unserem Bestellprogramm dann nur die Teile mit "K" bestellt werden sollen. Wenn die Unterscheidung nicht erfolgt und in die Bauteile in einer Baugruppe auch ein "K" geschrieben wird werden für eine Kaufteilbaugruppe so viele Datensätze erstellt wie Einzelteile in der Baugruppe vorhanden sind. Dies wäre aber nicht richtig.

Grüße Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1632
Registriert: 15.11.2006

Windows 10 x64, Inventor 2020

erstellt am: 11. Sep. 2020 23:48    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo

Wo das Bauteil verbaut ist, kannst du über rekursiven Durchlauf durch die SubOccurrences herausfinden. Der kurze Weg über AllReferencedDocuments funktioniert hier nicht mehr.
Dein Vorhaben funktioniert nur unter der Bedingung, dass die Bauteile einer Kaufbaugruppe nicht als Einzelkaufteile verbaut werden.
Denn sonst:
Ein Bauteil ist in einer Kaufbaugruppe verbaut, also Kategorie "KE". Dann verbaut jemand das Bauteil nochmal außerhalb der Kaufbaugruppe, also Kategorie "K". Da es die selbe Datei ist, gewinnt das letzte Vorkommen des Bauteils in der Occurrences-Struktur.

Des weiteren sollte man auch gleich darüber nachdenken was mit Unterbaugruppen in Kaufbaugruppen passiert. Auch eine Kategorie "K"? Bestellt euer Programm dann die Kaufbaugruppe und die Kaufunterbaugruppe?

Wie ermittelt euer Programm die zu bestellenden Teile und die Mengen? Beschreib bitte mal wer da was wann wo und wie ausliest oder überträgt. Sonst stückeln wir weiter zeilenweise Code aneinander und schmeißen es zum Schluß doch weg.

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

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

Thomas Thomas
Mitglied



Sehen Sie sich das Profil von Thomas Thomas an!   Senden Sie eine Private Message an Thomas Thomas  Schreiben Sie einen Gästebucheintrag für Thomas Thomas

Beiträge: 30
Registriert: 27.02.2020

erstellt am: 12. Sep. 2020 06:32    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo,

ok Danke, da schaue ich mir mal SubOccurrences an.

Zitat:
Dein Vorhaben funktioniert nur unter der Bedingung, dass die Bauteile einer Kaufbaugruppe nicht als Einzelkaufteile verbaut werden.

Das ist gegeben, das die Einzelteile von der Kaufteilbaugruppe nicht als Einzelteil verbaut sind.

Zitat:
Des weiteren sollte man auch gleich darüber nachdenken was mit Unterbaugruppen in Kaufbaugruppen passiert. Auch eine Kategorie "K"? Bestellt euer Programm dann die Kaufbaugruppe und die Kaufunterbaugruppe?

Das ist richtig, Unterbaugruppen kann es in der Kaufteilbaugruppe auch geben. Diese Kaufteil Unterbaugruppen müssten dann ein "KE" bekommen.

Zitat:
Wie ermittelt euer Programm die zu bestellenden Teile und die Mengen? Beschreib bitte mal wer da was wann wo und wie ausliest oder überträgt.

Das Programm liest die zuvor abgespeicherte Excel Stückliste ein. Wenn ein "KE" in der Kategorie steht wird die Zeile nicht beachtet. Damit wird dann die Kaufteilbaugruppe auch nur als ein Datensatz eingelesen, also es werden nur die Zeilen mit "K" eingelesen.

Grüße Thomas

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 1632
Registriert: 15.11.2006

Windows 10 x64, Inventor 2020

erstellt am: 15. Sep. 2020 08:45    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Thomas Thomas 10 Unities + Antwort hilfreich

Hallo

Sorry für die späte Antwort, ich war die letzten Tage verhindert.
Ich vermute ihr exportiert die Inventor Stückliste in eine Exceldatei. Warum nutzt ihr die Stücklisteneigenschaften "unteilbar" und "gekauft" nicht? Die bewirken einen Großteil dessen, was die Kategorien "K" und "KE" tun. Euer Bestellprogramm braucht dann die Bauteile einer Kaufbaugruppe nicht ausfiltern, da sie in der Stückliste nicht mehr vorhanden sind.

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

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2020 CAD.de | Impressum | Datenschutz