---

Guten Morgen zusammen,

aufgrund unseres nicht vorhandenen PDMŽs gibt es immer wieder Probleme die richtigen Daten zu finden bzw. die richtige Revision von Bauteilen.

Unsere Bauteile werden in einem Ordner gesammelt und bei einer neuen Revision kopiert und mit nem Buchstaben versehen Bsp. 123456B
D.h. im Datenordner liegen folgende Dateien: 123456; 123456A; 123456B wobei letzterer Stand der aktuelle ist.
Wenn ich jetzt eine Baugruppe öffne, würde ich gerne über ein Makro oder Ilogic eine Abfrage starten ob die Daten in der Baugruppe mit den Daten aus unserem Datenverzeichnis übereinstimmen oder nicht. Also Prüfung Wert "Sachnummer" aus benutzerdefinierte Eigenschaft mit "Dateiname" aus Datenverzeichnis.

Klingt nicht schwer aber für mich als Laie in VBA nicht so einfach.

Falls jemand helfen möchte?

Danke schon mal

Gruß

------------------
Gruß René

....................................................
Ich bin immer noch ein Mensch, keine Maschine!

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

---

Sorry, da steige ich noch nicht durch.
Soll immer die aktuelle Revision (also höchster vorhandener Index) verwendet sein? Es gibt wohl den Fall, dass in einer Bgr. eine ältere Revision verwendet wird, um einen älteren Stand zu dokumentieren, oder?
Deshalb der Abgleich zwischen Sachnummer und Dateiname? Wenn in Sachnummer und Dateiname Rev. B steht, es aber auch ein Modell mit Rev. C gibt, passt es dann?
Oder sind es im Grunde zwei Prüfungen:
- Passt Sachnummer zu Dateiname?
- Ist die aktuellste Revision verwendet?

Was soll passieren, wenn die Bedingung nicht erfüllt ist?
Meldung ausgeben / Liste irgendwo hin schreiben / Komponenten einfärben / i.O. Komp. unsichtbar schalten, Problemfälle bleiben sichtbar / ...?

Deine benutzerdefinierte Eigenschaft ist ein iProperty im Reiter Benutzerdefiniert, richtig?
Ist die Revision immer einstellig, oder gibt es auch ... Z / AA / AB / ...?
Sind immer alle Revisionen fortlaufend vorhanden, keine Lücken?
Ist die letzte Stelle der Sachnummer immer numerisch?
Ist die Sachnummer immer 6 stellig? (wäre egal, wenn man immer von rechts kommend die erste Zahl sucht)
Gibt es Modelle, die von der Prüfung ausgenommen werden sollen/müssen? z.B. Normteile. Was wären die Kriterien, um solche Modelle zu erkennen?

Schon mal ein bisschen Pseudo-Code

Code:

---

aktive IAM
Schleife über alle Occ In Occurrences
  oDoc = Document der Occ
  sPfad = Pfad (ohne Dateiname) von oDoc
  sDatei = Dateiname (ohne Pfad u. Endung) von oDoc
  sDatEnd = Dateiendung (iam oder ipt) von oDoc
  sSNrRev = iProp("Sachnummer" von oDoc)
  'evtl Prüfung ob sDatei = sSNrRev, aber das würde ich eher in eine eigene Regel auslagern
  WENN letzte Stelle aus sDatei numerisch:
    sRev = ""
    sSNr = sDatei
   ELSE
    sRev = letzte Stelle
    sSNr = sDatei ohne letzte Stelle
  aktRev = FUNCTION Finde_aktuellste_Rev(sPfad, sSNr, sRev, sDatEnd)
  WENN aktRev = sRev DANN
    ' ?
Next Occ

---

Code:

---

FUNCTION Finde_aktuellste_Rev(sPfad, sSNr, sRev, sDatEnd)
aktuellsteRev = sRev 'Default, falls weiter keine Datei existiert [Edit]
IF ""=sRev THEN iStart=Asc("A") ELSE iStart=Asc(sRev)+1
'Asc() liefert Asci-Wert zum Buchstaben
'Chr() liefert den Buchstaben zum Asci-Wert
For i = iStart to Asc("Z")
  sRev = Chr(i)
  sFile = sPfad & sSNr & SRev & "." & sDatEnd
  WENN sFile existiert DANN aktuellsteRev = sRev ELSE Exit For
Next i
RETURN aktuellsteRev

---

Optimierungspotential böte es, mehrmals vorhandene Komponenten nur einmal zu beackern. Das lassen wir aber erstmal sein.

------------------
Gruß KraBBy

[Diese Nachricht wurde von KraBBy am 14. Jul. 2023 editiert.]

[Diese Nachricht wurde von KraBBy am 16. Jul. 2023 editiert.]

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

---

Servus KraBBy,

in erster Linie geht es um eine Prüfung. Was nach erfolgreicher passieren soll wäre z.B. die Bauteile einfärben oder irgendwie kenntlich machen.

Da bei uns alle Daten in einem Ordner liegen müsste die Prüfung so laufen:

IProperty "Sachnummer" abgleichen mit dem Dateinamen im Zielordner (wo die Daten abliegen). Im Zielordner liegen alle Revisionen ab.

Die Sachnummer ist immer 6 Stellig und die Revision geht von A-Z, weiter sind wir noch nie gekommen ;-) und immer fortlaufend.

Ausgenommen von der Suche können bestimmte Nummerkreise sein, die z.B. mit einer 5 beginnen (Bsp.502346)

Die Prüfung soll nur helfen unsere Standardbaugruppen auf den aktuellsten Stand zu halten. Wir arbeiten mit mehreren Leuten an unterschiedlichen Unterbaugruppen und da kann es schon mal sein das jemand nur ein Bauteil ändert und vergisst es in der Baugruppe nachzuziehen.

Gruß

------------------
Gruß René

....................................................
Ich bin immer noch ein Mensch, keine Maschine!

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

---

Moin

Warum die Sachnummer? Das Property könnte auch mal einen falschen Wert haben. Vielleicht besser den Dateinamen selbst nehmen?
Sind da Unterbaugruppen vorhanden? Ohne Unterbaugruppen könnte man alle gefundenen Altexemplare durch die aktuellen austauschen lassen. Wenn es wirklich Revisionen sind, sollte das funktionieren ohne das die Abhängigkeiten verloren gehen. Mit Unterbaugruppen wäre es etwas aufwändiger.

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

---

In meinem Post oben habe ich den "Code" angepasst, so dass er ohne das iProperty auskommt und stattdessen nur den Dateinamen verwendet.

------------------
Gruß KraBBy

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

---

der Ablauf aus meinem Pseudo-Code umgesetzt.
Auf das iProperty habe ich verzichtet, wie geschrieben evtl. als eigene (iLogic)Regel implementieren...

Sollte durchlaufen, aber groß getestet habe ich das nicht. Ich habe mir keine Versuchsdaten mit Deinem Namensschema gebastelt. Das ersetzen deshalb nicht ausprobiert.

Code:

---

Option Explicit

Sub aktuelleRev_Main()
' in der aktiven Baugruppe wird für jede Komponente geprüft, ob jeweils die aktuelle Revision verwendet wird
' Unterbaugruppen werden nur als ganzes behandelt, einzelne Komponenten aus Unterbgr. nicht
'  ggf. muss das Makro dort separat ausgeführt werden

    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
   
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = oApp.ActiveDocument
   
    'Farbe bereitstellen
    Dim localAsset As Asset
    Set localAsset = makeAsset_available(oAsmDoc, "Rot")
    If localAsset Is Nothing Then Exit Sub  'falls in der Funktion was schief ging, z.B. Farbe nicht existiert
   
    Dim oOccs As ComponentOccurrences
    Set oOccs = oAsmDoc.ComponentDefinition.Occurrences
   
    'Schleife über alle Komponenten
    Dim oOcc As ComponentOccurrence, oDoc As Document
    Dim sFullFileName As String, sPfad As String, sDatei As String, sDatEnd As String
    Dim sRev As String, sSNr As String, sAktRev As String
    For Each oOcc In oOccs
        Set oDoc = oOcc.Definition.Document
        sFullFileName = oDoc.fullFilename
        sPfad = getPathName(sFullFileName)
        sDatei = GetFileName(sFullFileName)
        sDatEnd = GetFileExtension(sFullFileName)
        ' -> Prüfung, ob sDatei zum iProperty passt ggf. anderweitig
       
        If Occ2Skip(oOcc, sDatei) Then
            'nix tun, so wird die Komponente uebersprungen
            ' (Prüfung hier hoch gezogen, weil sonst bei ungespeicherten Dateien unten Left$() Fehler wirft)
        Else
            sRev = Right$(sDatei, 1)
            If IsNumeric(sRev) Then
                sRev = ""  'es gibt keine Revision
                sSNr = sDatei  'der Dateiname ist die SachNr.
            Else
                'sRev passt schon (ist letzte Stelle des Dateinamens, ist nicht numerisch)
                sSNr = Left$(sDatei, Len(sDatei) - 1)  'SachNr. ist Dateiname ohne letzte Stelle
            End If
       
            sAktRev = Finde_aktuellste_Rev(sPfad, sSNr, sRev, sDatEnd)
            If sAktRev = sRev Then
                'alles gut, nix zu tun
            Else    'es gibt eine aktuellere Rev
                Dim sNewCompFileName As String
                sNewCompFileName = sPfad & sSNr & sAktRev & sDatEnd 'Dateiname zusammensetzen
                Call veralteteOccBearbeiten(oOcc, sNewCompFileName, localAsset)
            End If
        End If
    Next 'oOcc
   
    MsgBox "fertig", vbOKOnly, "juhu"
End Sub

Private Sub veralteteOccBearbeiten(oOcc As ComponentOccurrence, sNewCompFileName As String, oFarbe As Asset)
' veraltete Komponente abarbeiten
'in eigenes Sub ausgelagert, um die Schleife in _Main nicht noch weiter aufzublasen

' durch aktuelle Rev. ersetzen oder einfärben

    ' Komponente markieren
    Dim oSel As SelectSet
    Set oSel = oOcc.Application.ActiveDocument.SelectSet
    oSel.Select oOcc
   
    'Meldung mit Frage
    Dim ret As VbMsgBoxResult
    ret = MsgBox("markierte Komponente durch aktuelle Rev. ersetzen?", vbQuestion + vbYesNoCancel, "Titel tbd.")
        'vmtl. sollten noch mehr Infos in die Meldung, SachNr. & Rev.  - spare ich mir hier
   
    If vbYes = ret Then
        'Komponente ersetzen
        On Error Resume Next
        Call oOcc.Replace(sNewCompFileName, ReplaceAll:=True)
        If Not 0 = Err.Number Then
            'Fehlerbehandlung falls Ersetzen nicht klappt
            ' # fehlt #
            MsgBox "veralteteOccBearbeiten - Replace", , "Fehlerbehandlung fehlt"
        End If
        On Error GoTo 0
    Else
        oOcc.Appearance = oFarbe    'Komponente faerben
        'kann hier was schief gehen?  # fehlt ggf. #
    End If
   
    oSel.Clear  'Markierung aufheben
   
End Sub

Private Function Finde_aktuellste_Rev(sPfad As String, sSNr As String, ByVal sRev As String, sDatEnd As String) As String
'findet die höchste Revision einer Sachnummer
'  Voraussetzungen:
'  - alle Revisionen müssen im gleichen Verzeichnis liegen
'  - Revisionen sind 1 stellig und in Grossbuchstaben
'  - es darf keine Revision(Datei) fehlen. Bsp.: liegen B & D vor, C fehlt  => Funktion liefert B (weil die Schleife bei C abbricht)
'
' erhöht in jedem Schritt der Schleife die Revision, setzt den Dateinamen zusammen
' wenn die Dateiexistiert, gibt es einen weiteren Durchlauf, ansonsten hatten wir im vorigen Schritt die höchste Rev.

    Dim aktuellsteRev As String, iStart As Integer, i As Integer, sFile As String
   
    aktuellsteRev = sRev 'Default, falls weiter keine Datei existiert
   
    If "" = sRev Then iStart = Asc("A") Else iStart = Asc(sRev) + 1
    'Asc() liefert Asci-Wert zum Buchstaben
    'Chr() liefert den Buchstaben zum Asci-Wert
    For i = iStart To Asc("Z")
      sRev = Chr(i)
      sFile = sPfad & sSNr & sRev & sDatEnd
      If "" = Dir(sFile) Then Exit For Else aktuellsteRev = sRev
      'Dir liefert "", wenn die Datei nicht existiert
    Next i
   
    'Rueckgabewert
    Finde_aktuellste_Rev = aktuellsteRev

End Function

Private Function Occ2Skip(oOcc As ComponentOccurrence, sDatei As String) As Boolean
    'hier können die Kritierien zusammengefasst werden
    ' um Komponenten zu überspringen
   
    Occ2Skip = True    'Defaultwert
   
    If "" = sDatei Then
        MsgBox "wohl noch nicht gespeichert... bessere Meldung nötig..."
        Exit Function
    ElseIf "5" = Left$(sDatei, 1) Then
        Exit Function
   
    'elseif ...
    ' ggf weitere, hab ich nicht erforscht
    ' Normteile
    ' virtuelle Komponenten ?
   
    End If
   
    'Rückgabewert, wenn alle obigen Kriterien nicht zutrafen
    Occ2Skip = False
End Function

---

Hilfsfunktionen:

Code:

---

Private Function GetFileName(sDatei_m_Pfad_u_Endung As String) As String
'liefert den Dateinamen ohne Pfad und Dateiendung
'ausgehend vom vollständigen Dateinamen (inkl. Pfad und Endung)
'rein text-basiert. keine Prüfung, ob Dateiexistiert oä.
' Pfad muss nicht enthalten sein
' der Dateiname darf mehrere Punkte enthalten (es wird nur der Text samt dem letzten Punkt entfernt)
'
' Sonderfälle:
' Eingabe ""  -> Rückgabe ""
' kein \ enthalten -> es wird die Dateiendung entfernt
' kein . enthalten -> es wird am Ende nichts entfernt
' kein . nach dem letzten \ aber vorher -> liefert alles nach dem letzten \
'
'KraBBy 08.01.2021

    GetFileName = ""    'Default-Rückgabewert
    If sDatei_m_Pfad_u_Endung = "" Then Exit Function
   
    Dim s As String
    s = sDatei_m_Pfad_u_Endung 'nur damit nicht der lange VarName mitgeschleppt werden muss
   
    Dim lSlash As Long
    lSlash = InStrRev(s, "\")  'Index von dem letzten BackSlash
    'sollte keiner vorhanden sein, ist das im weiteren kein Problem (lSlash=0, später je +1)
   
    Dim lDot As Long
    lDot = InStrRev(s, ".")    'index vom letzten Punkt
   
    Dim sReturn As String  'wird am Ende zurückgegeben
    If lDot = 0 Then
    'kein Punkt enthalten!
        sReturn = Mid$(s, lSlash + 1)  'am Ende nichts entfernen
    ElseIf lDot < lSlash Then
    'Punkt VOR dem letzten Backslash (also im Pfad)
        sReturn = Mid$(s, lSlash + 1)  'am Ende nichts entfernen
    Else
    'Standardfall: Punkt enthalten, nach dem letzten Backslash
   
        sReturn = Mid$(s, lSlash + 1, lDot - lSlash - 1)
        '+1: Slash soll nicht enthalten sein
        '-1: Punkt soll nicht enthalten sein
    End If
   
    GetFileName = sReturn  'Rückgabewert der Function
End Function

Private Function getPathName(sDatei_m_Pfad_u_Endung As String) As String 'liefert den Dateinamen ohne Pfad und Dateiendung
'ausgehend vom vollständigen Dateinamen (inkl. Pfad und ggf. Endung)
'rein text-basiert. keine Prüfung, ob Datei oder Pfad existiert oä.
'
' Sonderfälle:
' Eingabe ""  -> Rückgabe ""
' kein \ enthalten -> Rückgabe ""
' wird bereits ein Pfad angegeben mit \ am Ende, wird dieser unverändert zurückgegeben
'
'KraBBy 19.01.2021

    getPathName = ""    'Default-Rückgabewert
    If sDatei_m_Pfad_u_Endung = "" Then Exit Function
   
    Dim lSlash As Long
    lSlash = InStrRev(sDatei_m_Pfad_u_Endung, "\")  'Index von dem letzten BackSlash
    If 0 = lSlash Then Exit Function
   
    Dim sReturn As String  'wird am Ende zurückgegeben
   
    sReturn = Left$(sDatei_m_Pfad_u_Endung, lSlash)
    'Slash am Ende ist enthalten!
   
    getPathName = sReturn
End Function

Private Function GetFileExtension(sDatei_m_Pfad_u_Endung As String) As String
'liefert die Dateiendung, inkl. Punkt -> z.B. ".ipt"
'ausgehend vom vollständigen Dateinamen (inkl. Pfad und Endung)
'rein text-basiert. keine Prüfung, ob Dateiexistiert oä.
' Pfad muss nicht enthalten sein
' der Dateiname darf mehrere Punkte enthalten (es wird nur der Text samt dem letzten Punkt geliefert)

    GetFileExtension = ""    'Default-Rückgabewert
    If sDatei_m_Pfad_u_Endung = "" Then Exit Function
   
    Dim s As String
    s = sDatei_m_Pfad_u_Endung 'nur damit nicht der lange VarName mitgeschleppt werden muss
   
    Dim lSlash As Long
    lSlash = InStrRev(s, "\")  'Index von dem letzten BackSlash
    'sollte keiner vorhanden sein, ist das im weiteren kein Problem (lSlash=0)
   
    Dim lDot As Long
    lDot = InStrRev(s, ".")    'index vom letzten Punkt
   
    Dim sReturn As String  'wird am Ende zurückgegeben
    If lDot = 0 Then
    'kein Punkt enthalten!
        sReturn = ""    'keine Dateiendung
    ElseIf lDot < lSlash Then
    'Punkt VOR dem letzten Backslash (also im Pfad)
        sReturn = ""  'keine Dateiendung
    Else
    'Standardfall: Punkt enthalten, nach dem letzten Backslash
   
        sReturn = Mid$(s, lDot) 'Text ab und einschließlich dem Punkt
    End If
   
    GetFileExtension = sReturn  'Rückgabewert der Function
End Function

'wohl schon mal gepostet
'https://ww3.cad.de/foren/ubb/Forum258/HTML/001886.shtml
Private Function makeAsset_available(oDoc As Document, sColorName As String) As Asset
' püft ob die angegebene Farbe/Asset im angegebenen Dokument enthalten ist
' falls nicht, wird sie aus der Bibliothek eingefügt
' (erst dann steht sie im Dokument zur Verfügung)
    '    oDoc      :  PartDocument oder AssemblyDocument
    '  sColorName  :  Name der Farbe
' Rückgabewert ist die entsprechende Farbe als Asset-Object
'

    Dim localAsset As Asset
    On Error Resume Next
    Set localAsset = oDoc.Assets.Item(sColorName)
    If Err Then
        ' Failed to get the appearance in the document, so import it.
       
        ' Get an asset library by name.  Either the displayed name (which
        ' can changed based on the current language) or the internal name
        ' (which is always the same) can be used.
        Dim assetLib As AssetLibrary
        Set assetLib = ThisApplication.AssetLibraries.Item("_COLORS_") '############### Name der Bibliothek anpassen!
        'Set assetLib = ThisApplication.AssetLibraries.Item("314DE259-5443-4621-BFBD-1730C6CC9AE9")
       
        If assetLib Is Nothing Then
            ThisApplication.ScreenUpdating = True
            MsgBox "Keine Farb-Bibliothek mit dem angegebenen Namen gefunden!" & vbCrLf _
                & "Code überprüfen!", vbExclamation, "abgebrochen"
            Exit Function
        End If
       
        ' Get an asset in the library.  Again, either the displayed name or the internal
        ' name can be used.
        Dim libAsset As Asset
        Set libAsset = assetLib.AppearanceAssets.Item(sColorName)
       
        If libAsset Is Nothing Then 'Library oder Asset nicht vorhanden!
            ThisApplication.ScreenUpdating = True
            MsgBox "Keine Farbe mit diesem Namen in der Bibliothek gefunden!" & vbCrLf & _
                sColorName, vbInformation, "abgebrochen"
            Exit Function
        End If
       
        ' Copy the asset locally.
        Set localAsset = libAsset.CopyTo(oDoc)
    End If
    On Error GoTo 0
   
    'Rückgabewert
    Set makeAsset_available = localAsset
   
End Function

---

In der Fkt. makeAsset_available die Zeile
Set assetLib = ThisApplication.AssetLibraries.Item("_COLORS_")
anpassen mit dem Namen eurer Farb-Bibliothek!

PS: Sorry bzgl. der blöden Mischung aus Deutsch und Englisch in meinen Codes z.B. bei Variablennamen. Teilw. ist das aus der Hilfe oder sonst wo kopiert, teilweise eigene Willkür, weil es mir gerade so oder so passender/kürzer erscheint.

------------------
Gruß KraBBy

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

---

Servus KraBBy,

danke für den Code. ich muss jetzt nur mal Zeit finden das Ganze zu testen.

Ich gebe dir Bescheid wenn es soweit ist.

------------------
Gruß René

....................................................
Ich bin immer noch ein Mensch, keine Maschine!

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