---

Hallo!
              Ich versuche, eine rekursive Makro benenne ich alle ein Produkt partNumber seinem Dateiname zu machen, sondern die Beseitigung der letzten 4 Zeichen, aber mach mich nicht falsch auf dieser Linie

strNewName = Replace(strOldName, ".CATProduct", "")
strNewName2 = Right(strNewName.Name, 15)

..... Können Sie mir helfen?

Das ist code komplet:

'Option Explicit

Sub CATMain()

    On Error GoTo 0
     
    Dim oRoot As Document
    Set oRoot = CATIA.ActiveDocument
    Dim oProduct As Product
    Set oProduct = oRoot.Product
    Dim oProducts As Products
    Set oProducts = oProduct.Products

    Dim strOldName As String
    Dim strNewName As String
    strOldName = oRoot.Name
    strNewName = Replace(strOldName, ".CATProduct", "")
    oProduct.PartNumber = strNewName

    RecursiveThroughTree_fn2pn oProducts
 
End Sub

Sub RecursiveThroughTree_fn2pn(oProducts As Products)
    Dim oProduct As Product
    Dim oRefProduct As Product
    Dim oRefDocument As Document
    For Each oProduct In oProducts
        Set oRefProduct = oProduct.ReferenceProduct
        Set oRefDocument = oRefProduct.Parent
        Dim strOldName As String
        Dim strNewName As String
        Dim strNewName2 As String
        Dim strOldPath As String
        Dim strNewFullName As String

        If TypeName(oRefDocument) = "ProductDocument" Then
            Dim oProdDoc As ProductDocument
            Set oProdDoc = oRefDocument
            strOldName = oProdDoc.Name
            strNewName = Replace(strOldName, ".CATProduct", "")
            strNewName2 = Right(strNewName.Name, 15)
            oProdDoc.Product.PartNumber = strNewName
            If oProduct.Products.Count > 0 Then
            RecursiveThroughTree_fn2pn oProduct.ReferenceProduct.Products

            End If
        ElseIf TypeName(oRefDocument) = "PartDocument" Then
            Dim oPartDoc As PartDocument
            Set oPartDoc = oRefDocument
            strOldName = oPartDoc.Name
            strNewName = Replace(strOldName, ".CATPart", "")
            strNewName2 = Right(strNewName.Name, 15)
            oPartDoc.Product.PartNumber = strNewName
        End If
     
    Next
End Sub

Und das ist die alte Partnumber ich habe :
DJ119700-50500A01.CATProduct

Und das ist das anwort ich brauche :
DJ119700-50500.CATProduct

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

---

Servus
Nach meinem Verständnis nach willst du nicht (oder nicht nur) die Partnumber ändern sondern den Dateinamen.
Dazu fehlt dir in deinem Script ein SaveAs (zB ungetestet: oRefDocument.SaveAs strNewName2).
Dabei gehen aber (mit hoher Wahrscheinlichkeit) die Verknüpfungen zu den Zeichnungen verloren.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hallo Bernd!

                Thanks so die SaveAs bereits im Sinn hatte, ich ein anderes Makro, das durch die Übersetzung in chinesischen getan haben, aber ich muss zuerst nur ändern, Entfernen des letzten Zeichens PartNumber "A01" oder "P01", das ist meine wirkliche Absicht im Makro? können Sie mir helfen?

Vielen Danke

M.f.G.
Manuel

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

---

Servus
Bitte Systeminfo ausfüllen.
Was läuft in deinem Makro im Moment nicht richtig?
Ggf könntest du die neue partNumber auch so:
strNewName = Left(strOldName, InStr(strOldName, ".CATProduct")- 3)
oder
strNewName = Left(strOldName, len(strOldName) - len(".CATProduct")- 3)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Serbus Bernd!

Ich änderte den Code, um Ihre Linie und wenn ich richtig verstanden habe, funktioniert nicht:

Neue Code:

Option Explicit

Sub CATMain()

    On Error GoTo 0
     
    Dim oRoot As Document
    Set oRoot = CATIA.ActiveDocument
    Dim oProduct As Product
    Set oProduct = oRoot.Product
    Dim oProducts As Products
    Set oProducts = oProduct.Products

    Dim strOldName As String
    Dim strNewName As String
    strOldName = oRoot.Name
    strNewName = Replace(strOldName, ".CATProduct", "")
    oProduct.PartNumber = strNewName

    RecursiveThroughTree_fn2pn oProducts
 
End Sub

Sub RecursiveThroughTree_fn2pn(oProducts As Products)
    Dim oProduct As Product
    Dim oRefProduct As Product
    Dim oRefDocument As Document
    For Each oProduct In oProducts
        Set oRefProduct = oProduct.ReferenceProduct
        Set oRefDocument = oRefProduct.Parent
        Dim strOldName As String
        Dim strNewName As String
        'Dim strNewName2 As String
        Dim strOldPath As String
        Dim strNewFullName As String

        If TypeName(oRefDocument) = "ProductDocument" Then
            Dim oProdDoc As ProductDocument
            Set oProdDoc = oRefDocument
            strOldName = oProdDoc.Name
            strNewName = Left(strOldName, len(strOldName) - len(".CATProduct")- 3)
            'strNewName2 = Right(strNewName.Name, 15)
            oProdDoc.Product.PartNumber = strNewName
            If oProduct.Products.Count > 0 Then
            RecursiveThroughTree_fn2pn oProduct.ReferenceProduct.Products

            End If
        ElseIf TypeName(oRefDocument) = "PartDocument" Then
            Dim oPartDoc As PartDocument
            Set oPartDoc = oRefDocument
            strOldName = oPartDoc.Name
            strNewName = Left(strOldName, len(strOldName) - len(".CATProduct")- 3)
            'strNewName2 = Right(strNewName.Name, 15)
            oPartDoc.Product.PartNumber = strNewName
        End If
     
    Next
End Sub

Das sind die Antworte :

CATPRODUCT original:

DJ119700-50400A01
-----DJ119700-50401P01(DJ119700-50401P01.1)
-----DJ119700-50402P01(DJ119700-50402P01.1)
-----DJ119700-50403P01(DJ119700-50403P01.1)

CATPRODUCT mit macro:

DJ119700-50400A01.CATProduct
-----DJ119700-50(DJ119700-50401P01.1)
-----DJ119700-50402P01(DJ119700-50402P01.1)
-----DJ119700-50403P01(DJ119700-50403P01.1)

und das muss richtig was ich will:

DJ119700-50400
-----DJ119700-50401(DJ119700-50401P01.1)
-----DJ119700-50402(DJ119700-50402P01.1)
-----DJ119700-50403(DJ119700-50403P01.1)

Macht nichr recursive nüer die erste CatPart nicht Gut aber die andere un CatProduct macht nicht.

Vielen Dank

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

---

Servus
Warum nimmst du nicht die PartNumber, undkkürz diese dann?
Lass dir mal die Variablen strOldName und strNewName per Messagebox ausgeben, um die Stingmodifikation zu korrigieren.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

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

---

Hallo Bernd!

                Vielen Dank für deine Hilfe ich habe die Fehler bekommt und jetzt funzioniert Gutt ich sende der Code ob jemand braucht auch.

Vielen Dank.

Code GUT:

Sub CATMain()

    On Error GoTo 0
     
    Dim oRoot As Document
    Set oRoot = CATIA.ActiveDocument
    Dim oProduct As Product
    Set oProduct = oRoot.Product
    Dim oProducts As Products
    Set oProducts = oProduct.Products

    Dim strOldName As String
    Dim strNewName As String   
    strOldName = oRoot.Name
    strNewName = Left(strOldName, len(strOldName) - len(".CATProduct")- 3)
    oProduct.PartNumber = strNewName

    RecursiveThroughTree_fn2pn oProducts
 
End Sub

Sub RecursiveThroughTree_fn2pn(oProducts As Products)
    Dim oProduct As Product
    Dim oRefProduct As Product
    Dim oRefDocument As Document
    For Each oProduct In oProducts
        Set oRefProduct = oProduct.ReferenceProduct
        Set oRefDocument = oRefProduct.Parent
        Dim strOldName As String
        Dim strNewName As String
        Dim strOldPath As String
        Dim strNewFullName As String

        If TypeName(oRefDocument) = "ProductDocument" Then
            Dim oProdDoc As ProductDocument
            Set oProdDoc = oRefDocument
            strOldName = oProdDoc.Name
            strNewName = Left(strOldName, len(strOldName) - len(".CATProduct")- 3)           
            oProdDoc.Product.PartNumber = strNewName
            If oProduct.Products.Count > 0 Then
            RecursiveThroughTree_fn2pn oProduct.ReferenceProduct.Products

            End If
        ElseIf TypeName(oRefDocument) = "PartDocument" Then
            Dim oPartDoc As PartDocument
            Set oPartDoc = oRefDocument
            strOldName = oPartDoc.Name
            strNewName = Left(strOldName, len(strOldName) - len(".CATPart")- 3)           
            oPartDoc.Product.PartNumber = strNewName
        End If
     
    Next
End Sub

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