---

Hallo zusammen,

wie müsste den ein Makro aussehen dass den Browserknoten in einer Baugruppe mit einer Benutzerdefinierten Eigenschaft die in den I-Properties hinterlegt ist füllt.

Danke und Gruß

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

---

z.B. so:

Code:

---

Dim sMsg As String

Public Sub DisplayNameAufbereiten()
    ' Display Name lesbarer machen
   
    If ThisApplication.ActiveDocumentType <> kAssemblyDocumentObject And _
        ThisApplication.ActiveDocumentType <> kPartDocumentObject And _
        ThisApplication.ActiveDocumentType <> kPresentationDocumentObject And _
        ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
        'MsgBox "Only Part or Assymbly or Drawing document", vbCritical
        Exit Sub
    End If
   
  ' Declare the Application object
    Dim oApplication As Inventor.Application

    ' Obtain the Inventor Application object.
    ' This assumes Inventor is already running.
    Set oApplication = ThisApplication
   
    ' Set a reference to the active document.
    ' This assumes a document is open.
    Dim oDoc As Document
    Set oDoc = oApplication.ActiveDocument
   
    Dim sFileName As String
    Dim iStart As Integer

    If ThisApplication.ActiveDocumentType = kDrawingDocumentObject Then
   
        sFileName = StandardModule.FileName(oDoc.FullFileName)
       
        oDoc.DisplayName = sFileName
       
    Else
   
        Dim sPartNumber As String
        Dim sDespription As String
        Dim sSubject As String
        Dim sTrennzeichen As String
   
        sPartNumber = Property_lesen(oDoc, "Part Number")
        sDespription = Property_lesen(oDoc, "Description")
        sSubject = Property_lesen(oDoc, "Subject")
   
        If Len(sPartNumber) = 0 Or Len(sDespription) = 0 Then
            sTrennzeichen = ""
        Else
            sTrennzeichen = " - "
        End If
   
        oDoc.DisplayName = sPartNumber & sTrennzeichen & sDespription
   
        If Len(sSubject) = 0 Then
            sTrennzeichen = ""
        Else
            sTrennzeichen = " - "
        End If
   
        oDoc.DisplayName = oDoc.DisplayName & sTrennzeichen & sSubject
   
   
       
        ' Überprüfung, ob Displayname, Partnumber und Dateiname harmonieren
       
        Dim sDisplayName As String
       
        sPartNumber = CStr(IPropEintraege.Property_lesen(oDoc, "Part Number"))
        sDisplayName = CStr(oDoc.DisplayName)
        'MsgBox CStr(InStr(1, sDisplayName, sPartNumber, vbTextCompare))
   
        sFileName = StandardModule.FileName(oDoc.FullFileName)
           
        ' Überprüfung, ob die Teilenummer im Display-Namen vorkommt
        If Not (InStr(1, sDisplayName, sPartNumber, vbTextCompare) = 1 And _
                InStr(1, sFileName, sPartNumber, vbTextCompare) = 1) Then
               
            Debug.Print sDisplayName
            Debug.Print sPartNumber
            Debug.Print sFileName
           
            sMsg = "Teilenummer, Filename und Display-Namen sind nicht synchron!" & vbCrLf & vbCrLf & _
                    "Display-Name: " & vbTab & sDisplayName & vbCrLf & _
                    "Teilenummer : " & vbTab & sPartNumber & vbCrLf & _
                    "Filename    : " & vbTab & sFileName & vbCrLf & _
                    vbCrLf & _
                    "sollen die Teilenummer und der Display-Name aus dem Filename generiert werden?" & _
                    vbCrLf
                   
            If MsgBox(sMsg, vbYesNoCancel) = vbYes Then
           
                If oDoc.FileSaveCounter > 0 Then
               
                    iStart = InStrRev(sFileName, ".", -1, vbTextCompare)
                    sFileName = Left$(sFileName, iStart - 1)
               
                    If Len(sDespription) = 0 Then
                        sTrennzeichen = ""
                    Else
                        sTrennzeichen = " - "
                    End If
       
                    oDoc.DisplayName = sFileName & sTrennzeichen & sDespription
               
                    Call IPropEintraege.Property_setzen(oDoc, "Part Number", sFileName)
                End If
            Else
                    If Len(sDespription) = 0 Then
                        sTrennzeichen = ""
                    Else
                        sTrennzeichen = " - "
                    End If
       
                    oDoc.DisplayName = sPartNumber & sTrennzeichen & sDespription
               

            End If
         
        End If
           
   
    End If
   
    Set oApplication = Nothing
    Set oDoc = Nothing

End Sub

---

Lies das mal durch. Das Makro macht noch mehr.

------------------
mit freundlichem Gruß
aus der Burggemeinde Brüggen
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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

---

Danke erst ein mal,
werde ich gleich mal testen...

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

---

Zitat:

---

Original erstellt von Lothar Boekels:
z.B. so:

[code]

   
        sPartNumber = Property_lesen(oDoc, "Part Number")
        sDespription = Property_lesen(oDoc, "Description")
        sSubject = Property_lesen(oDoc, "Subject")
   
       

---

Hallo,

Bekomme die Fehlermeldung:

Sub oder Function nicht definiert!

Was mach ich da Falsch?

Danke und Gruß

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

---

Da fehlt dir wohl die Nebenfunktion vom Lothar, in der er die iProps ausliest.
Wenn er dir die noch gibt, dann läuft es sicher durch.

------------------
MFG

Chris

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

---

Code:

---

Public Function Property_lesen(oDoc As Document, sPropName As String) As Variant
' Liest eine Property.
' Ist die Property nicht vorhanden, so wird "" zurückgegeben.

    Property_lesen = ""

If oDoc Is Nothing Then Return

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

    Dim oProp As Property
   
    ' Iterate through all the PropertySets one by one using for loop
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
   
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.name = sPropName Then
                Property_lesen = oProp.Value
                Exit For
            End If
        Next
       
    Next

End Function

---

------------------
mit freundlichem Gruß
aus der Burggemeinde Brüggen
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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

---

Hatte zwischenzeitlich die Zeilen schon in einem anderen Beitrag gefunden und festgestellt……
ich muß noch viel lesen und dabei lernen

Vielen Dank!

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

---

Hallo,

vielen Dank erstmal für den Code!
Beim ausprobieren bekomme ich noch ein paar Fehler, ich denke es liegt daran, dass mir die folgeneden Funktionen noch fehlen:

Call IPropEintraege.Property_setzen(odoc, "Part Number", sFileName)
compile error: Method or data member not found

das habe ich dann erstmal auskommentiert und bekomme bei:

sFileName = StandardModule.FileName(odoc.FullFileName)

den nächsten Fehler: Object reqiered

Was fehlt mir da noch?

Funktioniert dieses Makro dann auch für Umbenennung der Browserknoten von Einzelteilen in der Baugruppe?

Viele Grüße
Dirk

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

---

Code:

---

Public Sub Property_setzen(oDoc As Document, sPropName As String, vPropValue As Variant)
' Belegt eine Property mit einem Wert.
' Ist die Property nicht vorhanden, so wird sie angelegt.

    ' Obtain the PropertySets collection object
    Dim oPropSets As PropertySets
    Set oPropSets = oDoc.PropertySets

 
    Dim bPropertyDa As Boolean
    Dim oProp As Property
   
    bPropertyDa = False
   
    On Error Resume Next
   
    ' Iterate through all the PropertySets one by one using for loop
    ' and changing its value if found
    Dim oPropSet As PropertySet
    For Each oPropSet In oPropSets
   
        For Each oProp In oPropSet
            'Debug.Print oProp.Name
            If oProp.name = sPropName Then
                oProp.Value = vPropValue
                bPropertyDa = True
                Exit For
            End If
        Next
       
    Next
   
 
    'Property anlegen und Wert eintragen
   
    If Not bPropertyDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vPropValue, sPropName
        'oDoc.PropertySets.Item("User Defined Properties").Add vPropValue, sPropName
    End If
   
    On Error GoTo 0
 
End Sub

---

------------------
mit freundlichem Gruß
aus der Burggemeinde Brüggen
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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

---

Code:

---

Public Function FileName(ByVal sFullFilename As String) As String
   
    Dim iStart As Long
   
    iStart = InStrRev(sFullFilename, "\", -1, vbTextCompare)
    FileName = Mid$(sFullFilename, iStart + 1)
   

End Function

---

------------------
mit freundlichem Gruß
aus der Burggemeinde Brüggen
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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

---

Moin!

Ist Dir klar,  dass diese Umbenennung dann statisch ist? Wenn dieser Code nicht immer wieder neu angestoßen wird, z. B. auch weil er auf anderen Rechnern gar nicht vorhanden, bleiben diese Einträge später immer unverändert. Wenn man dann Komponenten in der Baugruppe tauscht, ist die Verwirrung u. U. groß.

------------------
Roland  
www.Das-Entwicklungsbuero.de

It's not the hammer - it's the way you hit!

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

---

- Inhaltsloser Beitrag -

---

Deswegen greift das Makro ja auch nicht die Browserknoten an, sondern ändert den Displaynamen der betreffenden Dateien, damit sich diese in der Baugruppe brav damit melden können.

------------------
mit freundlichem Gruß
aus der Burggemeinde Brüggen
Lothar Boekels

-----------------------------------------------------
Wir unterstützen die Arbeit der
Rettungshundestaffel des DRK in Viersen

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