---

HALLO!

Ich möchte diesen Code zu ändern fand ich und ich meine "UserRefProperties" als Material, WIDTH, etc.. Können Sie mir helfen und mir sagen, wie ich es tue?

   

Und was ich tun kann, um die Liste von unten nach oben, nicht von oben nach unten erzeugt wird, wie es jetzt tut.

Vielen Dank.

Der Code Catvba ist.

Code:

---

Option Explicit
Sub CATMain()

'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant

'Compruebe que la ActiveDocument es un CATDrawing.
'Si no es así, informar al usuario y terminar la ejecución.

Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "Esta utilidad debe ejecutarse desde un CATDrawing."
Exit Sub
End If

'Variables publicas

Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")

'Buscar a través de la estructura del CATProduct verificando la cantidad de cada componente.
'Añadir los componente en una lista de productos para su uso en el futuro.

Dim n As Integer
Dim ProductList() As Product
ReDim ProductList(oProducts.Count) 'Número total de productos.
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n

'Comprueba si una lista de materiales ya ha sido creada en el dibujo.
'Este código se utilizará cuando haya actualizaciones  necesarias en la lista de materiales.
'Si lista de materiales ya existe, se dirije al código que publica la lista de materiales.

For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then 'Verifica si existe la Tabla
Dim RowCount As Integer
If oDrawingTable.NumberOfRows > (QtyDict.Count) Then 'Borra las filas inecesarias.
For RowCount = (QtyDict.Count + 1) To oDrawingTable.NumberOfRows
    oDrawingTable.RemoveRow 2
Next RowCount
End If
    If oDrawingTable.NumberOfRows < (QtyDict.Count + 1) Then 'Añade filas necesarias.
    For RowCount = oDrawingTable.NumberOfRows To (QtyDict.Count)
    oDrawingTable.AddRow 2
    Next RowCount
    End If
GoTo POPULATEBOM 'Si la tabla existe
End If
Next n

'Si la tabla no existe, crear una etiqueta y lo mismo que el nombre de la tabla que se busca.

Set oDrawingTable = oDrawingTables.Add(50, 50, QtyDict.Count + 1, 6, 10, 10)
oDrawingTable.Name = "DrawingBOM" 'Etiqueta de la Tabla
oDrawingTable.AnchorPoint = CatTableBottomLeft 'Posicionamiento de la esquina inferior izquierda de la Tabla

'Filas publicadas en la BOM de la Tabla

POPULATEBOM:
'Texto de encabezado
Call oDrawingTable.SetCellString(1, 1, "INDEX")             'QtyDict.Count
Call oDrawingTable.SetCellString(1, 2, "QTY")           'QtyDict.Item
Call oDrawingTable.SetCellString(1, 3, "CODE")          'Definition
Call oDrawingTable.SetCellString(1, 4, "PART NUMBER")   'Part Number
Call oDrawingTable.SetCellString(1, 5, "DESCRIPTION")   'Nomenclature
Call oDrawingTable.SetCellString(1, 6, "DESIGNACION")   'DescriptionInst

'Ancho de cabecera
Call oDrawingTable.SetColumnSize(1, 18) 'Index
Call oDrawingTable.SetColumnSize(2, 15) 'Qty
Call oDrawingTable.SetColumnSize(3, 60) 'Code
Call oDrawingTable.SetColumnSize(4, 60) 'Part Number
Call oDrawingTable.SetColumnSize(5, 60) 'Description
Call oDrawingTable.SetColumnSize(6, 60) 'Note

'Ancho de la ubicación.
For n = 1 To 6
Call oDrawingTable.SetCellAlignment(1, n, CatTableMiddleCenter) 'Centro de las Descripciones
Next n

'Utiliza la lista creada anteriormente con el fin de llenar la información de cada CATPart del CATProducto.
Dim i As Integer
For n = 2 To oDrawingTable.NumberOfRows

    'Llenar filas
    Call oDrawingTable.SetCellString(n, 1, (n - 1))                                 'Index
    Call oDrawingTable.SetCellString(n, 2, QtyDict.Item(ProductList(n - 1).PartNumber))     'Qty
    Call oDrawingTable.SetCellString(n, 3, ProductList(n - 1).Definition)           'Code
    Call oDrawingTable.SetCellString(n, 4, ProductList(n - 1).PartNumber)           'Part Number
    Call oDrawingTable.SetCellString(n, 5, ProductList(n - 1).Nomenclature)             'Description
    Call oDrawingTable.SetCellString(n, 6, ProductList(n - 1).DescriptionInst)          'Note
    Call oDrawingTable.SetCellString(n, 6, ProductList(n - 1).Product.UserRefProperties("MATERIAL"))          'Dies ist ein Test funktioniert aber nicht, warum?

    'Justificar, posicionar filas
    For i = 1 To 2
        Call oDrawingTable.SetCellAlignment(n, i, CatTableMiddleCenter)         'Centro 1 & 2
        Call oDrawingTable.SetCellAlignment(n, i + 2, CatTableMiddleLeft)   'Posicion derecha 3 & 4
        Call oDrawingTable.SetCellAlignment(n, i + 4, CatTableMiddleLeft)   'Posicion derecha 5 & 6
    Next i
Next n

End Sub

---

[Diese Nachricht wurde von xyon126 am 20. Dez. 2011 editiert.]

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

---

Servus
Ändere mal die Zeile in:
Call oDrawingTable.SetCellString(n, 6, ProductList(n - 1).ReferenceProduct.UserRefProperties("MATERIAL").ValueAsString)

Gruß
Bernd

PS: Bitte Systeminfo ausfüllen.

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

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

---

Hallo Bernd!

          Vielen Dank, Es funktioniert nicht, bekomme ich Fehler 438

und zeichne diese Tabelle.

Was kann es?

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

---

Servus
Bitte Systeminfo ausfüllen.
Gibt es diesen Parameter auch im Part/Unterbaugruppe?
Setze mal im VBA-Editor an dieser Stelle ein "Break" und untersuche mit dem Watch/Local-Fenster dein Objekt Prodctlist.

Gruß
Bernd

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

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

---

BOM.zip

Hallo Bernd!

    Ich öffnete die Debug auf der Linie der Fehler zu überprüfen, und das ist die Linie.

Wenn ich verstehen, wenn Sie sagen: "Bitte Systeminfo ausfüllen."
Ich lud die volle CATProduct Ich lief das Makro aus der Zeichnung, da dies den zusätzlichen Informationen in Excel BOM mir, dass keine Daten.

Vielen Dank

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

---

Servus
Das Problem ist, das diese Benutzerparameter (wahrscheinlich noch Catia-Sprachabhängig) einen anderen Namen haben. In der deutschen Umgebung ergibt sich zB folgender Parametername "Einzelteil_1\Eigenschaften\MATERIAL".
Entweder müsstest du diesen Namen immer zusammenstellen. Oder mit einer Funktion den richtigen Parameter suchen lassen (ungetestet):

Code:

---

Function UserparameterByName(oProduct As Product, strParameter As String) As Parameter
    Dim UserParameters As Parameters
    Dim oParameter As Parameter
   
    Set UserParameters = oProduct.ReferenceProduct.UserRefProperties
    For i = 1 To UserParameters.Count
        Set oParameter = UserParameters.Item(i)
        If Right(oParameter.Name, Len(strParameter)) = strParameter Then
            Set UserparameterByName = oParameter
            Exit Function
        End If
    Next
       
    Set UserparameterByName = Nothing

End Function

---

Der Aufruf würde dann zB so erfolgen:

Code:

---

Dim UserParameter As Parameter

Set UserParameter = UserparameterByName(ProductList(n - 1), "MATERIAL")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString) 
End If

---

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

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

---

Hallo Bernd!

                Ich verstehe Ihren Code gut, weil ich diese in einige Makro beantragt haben und mit Ihrer Hilfe ich denke, auch den gleichen Code, aber wie kann ich in dem obigen Code anwenden?
                Die Funktion ist unklar, wer unabhängig ist und wird am Ende aber wenn ich die Zeile "UserReferenceProperties (" Material ") gesetzt wird, weil meine Absicht ist es, nicht nur add (" Material "), sondern auch, DIN, Breite, Länge, usw. wie Sie gesehen haben in der "EXCEL BOM" Soll ich den gesamten Code für jede Art von Anruf UserReferenceProperties?,

Vielen Dank

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

---

Servus
Die Funktion wird nur einmal im Projekt (nicht in einer Sub) erstellt.
Für jeden weiteren Parameter musst du nur diese Zeilen anpassen/neu einfügen:

Code:

---

Set UserParameter = UserparameterByName(ProductList(n - 1), "LENGHT")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If

---

Dabei nur einen andern Parameternamen übergaben und ggf die Spalte richtig definieren (beides fett markiert)

Gruß
Bernd

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

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

---

Hallo Bernd!

Also, wenn ich das verstehen würde wie folgt aussehen:

Code:

---

Option Explicit
Sub CATMain()

'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant

'Compruebe que la ActiveDocument es un CATDrawing.
'Si no es así, informar al usuario y terminar la ejecución.

Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "Esta utilidad debe ejecutarse desde un CATDrawing."
Exit Sub
End If

'Variables publicas

Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")

'Buscar a través de la estructura del CATProduct verificando la cantidad de cada componente.
'Añadir los componente en una lista de productos para su uso en el futuro.

Dim n As Integer
Dim ProductList() As Product
ReDim ProductList(oProducts.Count) 'Número total de productos.
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n

'Comprueba si una lista de materiales ya ha sido creada en el dibujo.
'Este código se utilizará cuando haya actualizaciones  necesarias en la lista de materiales.
'Si lista de materiales ya existe, se dirije al código que publica la lista de materiales.

For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then 'Verifica si existe la Tabla
Dim RowCount As Integer
If oDrawingTable.NumberOfRows > (QtyDict.Count) Then 'Borra las filas inecesarias.
For RowCount = (QtyDict.Count + 1) To oDrawingTable.NumberOfRows
    oDrawingTable.RemoveRow 2
Next RowCount
End If
    If oDrawingTable.NumberOfRows < (QtyDict.Count + 1) Then 'Añade filas necesarias.
    For RowCount = oDrawingTable.NumberOfRows To (QtyDict.Count)
    oDrawingTable.AddRow 2
    Next RowCount
    End If
GoTo POPULATEBOM 'Si la tabla existe
End If
Next n

'Si la tabla no existe, crear una etiqueta y lo mismo que el nombre de la tabla que se busca.

Set oDrawingTable = oDrawingTables.Add(50, 50, QtyDict.Count + 1, 6, 10, 10)
oDrawingTable.Name = "DrawingBOM" 'Etiqueta de la Tabla
oDrawingTable.AnchorPoint = CatTableBottomLeft 'Posicionamiento de la esquina inferior izquierda de la Tabla

'Filas publicadas en la BOM de la Tabla

POPULATEBOM:
'Texto de encabezado
Call oDrawingTable.SetCellString(1, 1, "INDEX")            'QtyDict.Count
Call oDrawingTable.SetCellString(1, 2, "QTY")          'QtyDict.Item
Call oDrawingTable.SetCellString(1, 3, "CODE")          'Definition
Call oDrawingTable.SetCellString(1, 4, "DESIGNACION")  'UserRefProperties "DESIGNACION"
Call oDrawingTable.SetCellString(1, 5, "ANCHO")        'UserRefProperties "ANCHO"
Call oDrawingTable.SetCellString(1, 6, "MATERIAL")      'UserRefProperties "MATERIAL"

'Ancho de cabecera
Call oDrawingTable.SetColumnSize(1, 18) 'Index
Call oDrawingTable.SetColumnSize(2, 15) 'Qty
Call oDrawingTable.SetColumnSize(3, 60) 'Code
Call oDrawingTable.SetColumnSize(4, 60) 'UserRefProperties "DESIGNACION"
Call oDrawingTable.SetColumnSize(5, 60) 'UserRefProperties "ANCHO"
Call oDrawingTable.SetColumnSize(6, 60) 'UserRefProperties "MATERIAL"

'Ancho de la ubicación.
For n = 1 To 6
Call oDrawingTable.SetCellAlignment(1, n, CatTableMiddleCenter) 'Centro de las Descripciones
Next n

'Utiliza la lista creada anteriormente con el fin de llenar la información de cada CATPart del CATProducto.
Dim i As Integer
Dim UserParameter As Parameter

For n = 2 To oDrawingTable.NumberOfRows

    'Llenar filas
Call oDrawingTable.SetCellString(n, 1, (n - 1)) 'Index
Call oDrawingTable.SetCellString(n, 2, QtyDict.Item(ProductList(n - 1).PartNumber)) 'Qty
Call oDrawingTable.SetCellString(n, 3, ProductList(n - 1).Definition) 'Code
Set UserParameter = UserparameterByName(ProductList(n - 1), "DESIGNACION")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "ANCHO")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "MATERIAL")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If

'Justificar, posicionar filas
For i = 1 To 2
Call oDrawingTable.SetCellAlignment(n, i, CatTableMiddleCenter) 'Centro 1 & 2
Call oDrawingTable.SetCellAlignment(n, i + 2, CatTableMiddleLeft) 'Posicion derecha 3 & 4
Call oDrawingTable.SetCellAlignment(n, i + 4, CatTableMiddleLeft) 'Posicion derecha 5 & 6
Next i
Next n

Function UserparameterByName(oProduct As Product, strParameter As String) As Parameter
    Dim UserParameters As Parameters
    Dim oParameter As Parameter
 
    Set UserParameters = oProduct.ReferenceProduct.UserRefProperties
    For i = 1 To UserParameters.Count
        Set oParameter = UserParameters.Item(i)
        If Right(oParameter.Name, Len(strParameter)) = strParameter Then
            Set UserparameterByName = oParameter
            Exit Function
        End If
    Next
     
    Set UserparameterByName = Nothing

End Function

End Sub

---

Fehlt etwas, oder ist es so?

Verzeih mir, aber ist das mit der Catia VBA ist sehr schwer, mich zu verstehen, wenn ich vergleichen mit den VB6.0 etwas, was ich tun einfach und VBA hier und erfüllen die deutsche Sprache ist.

Vielen Danke

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

---

Servus
Wenn du jetzt noch die Funktion außerhalb der Sub anordnest sollte es funktionieren (ungetestet). Probiere mal mit dem Watchfenster und dem Schrittwiesen Ablauf des Makros: das Makro nachzuvollziehen, und ggf noch letzte Fehler auszubessern

Code:

---

Option Explicit
Sub CATMain()

'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant

'Compruebe que la ActiveDocument es un CATDrawing.
'Si no es así, informar al usuario y terminar la ejecución.

Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "Esta utilidad debe ejecutarse desde un CATDrawing."
Exit Sub
End If

'Variables publicas

Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")

'Buscar a través de la estructura del CATProduct verificando la cantidad de cada componente.
'Añadir los componente en una lista de productos para su uso en el futuro.

Dim n As Integer
Dim ProductList() As Product
ReDim ProductList(oProducts.Count) 'Número total de productos.
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n

'Comprueba si una lista de materiales ya ha sido creada en el dibujo.
'Este código se utilizará cuando haya actualizaciones  necesarias en la lista de materiales.
'Si lista de materiales ya existe, se dirije al código que publica la lista de materiales.

For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then 'Verifica si existe la Tabla
Dim RowCount As Integer
If oDrawingTable.NumberOfRows > (QtyDict.Count) Then 'Borra las filas inecesarias.
For RowCount = (QtyDict.Count + 1) To oDrawingTable.NumberOfRows
    oDrawingTable.RemoveRow 2
Next RowCount
End If
    If oDrawingTable.NumberOfRows < (QtyDict.Count + 1) Then 'Añade filas necesarias.
    For RowCount = oDrawingTable.NumberOfRows To (QtyDict.Count)
    oDrawingTable.AddRow 2
    Next RowCount
    End If
GoTo POPULATEBOM 'Si la tabla existe
End If
Next n

'Si la tabla no existe, crear una etiqueta y lo mismo que el nombre de la tabla que se busca.

Set oDrawingTable = oDrawingTables.Add(50, 50, QtyDict.Count + 1, 6, 10, 10)
oDrawingTable.Name = "DrawingBOM" 'Etiqueta de la Tabla
oDrawingTable.AnchorPoint = CatTableBottomLeft 'Posicionamiento de la esquina inferior izquierda de la Tabla

'Filas publicadas en la BOM de la Tabla

POPULATEBOM:
'Texto de encabezado
Call oDrawingTable.SetCellString(1, 1, "INDEX")            'QtyDict.Count
Call oDrawingTable.SetCellString(1, 2, "QTY")          'QtyDict.Item
Call oDrawingTable.SetCellString(1, 3, "CODE")          'Definition
Call oDrawingTable.SetCellString(1, 4, "DESIGNACION")  'UserRefProperties "DESIGNACION"
Call oDrawingTable.SetCellString(1, 5, "ANCHO")        'UserRefProperties "ANCHO"
Call oDrawingTable.SetCellString(1, 6, "MATERIAL")      'UserRefProperties "MATERIAL"

'Ancho de cabecera
Call oDrawingTable.SetColumnSize(1, 18) 'Index
Call oDrawingTable.SetColumnSize(2, 15) 'Qty
Call oDrawingTable.SetColumnSize(3, 60) 'Code
Call oDrawingTable.SetColumnSize(4, 60) 'UserRefProperties "DESIGNACION"
Call oDrawingTable.SetColumnSize(5, 60) 'UserRefProperties "ANCHO"
Call oDrawingTable.SetColumnSize(6, 60) 'UserRefProperties "MATERIAL"

'Ancho de la ubicación.
For n = 1 To 6
Call oDrawingTable.SetCellAlignment(1, n, CatTableMiddleCenter) 'Centro de las Descripciones
Next n

'Utiliza la lista creada anteriormente con el fin de llenar la información de cada CATPart del CATProducto.
Dim i As Integer
Dim UserParameter As Parameter

For n = 2 To oDrawingTable.NumberOfRows

    'Llenar filas
Call oDrawingTable.SetCellString(n, 1, (n - 1)) 'Index
Call oDrawingTable.SetCellString(n, 2, QtyDict.Item(ProductList(n - 1).PartNumber)) 'Qty
Call oDrawingTable.SetCellString(n, 3, ProductList(n - 1).Definition) 'Code
Set UserParameter = UserparameterByName(ProductList(n - 1), "DESIGNACION")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "ANCHO")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "MATERIAL")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If

'Justificar, posicionar filas
For i = 1 To 2
Call oDrawingTable.SetCellAlignment(n, i, CatTableMiddleCenter) 'Centro 1 & 2
Call oDrawingTable.SetCellAlignment(n, i + 2, CatTableMiddleLeft) 'Posicion derecha 3 & 4
Call oDrawingTable.SetCellAlignment(n, i + 4, CatTableMiddleLeft) 'Posicion derecha 5 & 6
Next i
Next n

End Sub

Function UserparameterByName(oProduct As Product, strParameter As String) As Parameter
    Dim UserParameters As Parameters
    Dim oParameter As Parameter

    Set UserParameters = oProduct.ReferenceProduct.UserRefProperties
    For i = 1 To UserParameters.Count
        Set oParameter = UserParameters.Item(i)
        If Right(oParameter.Name, Len(strParameter)) = strParameter Then
            Set UserparameterByName = oParameter
            Exit Function
        End If
    Next
   
    Set UserparameterByName = Nothing

End Function

---

Ein schönes Makro. Anbei noch ein paar Hinweise (meine persönliche Meinung)
- vielleicht gleich alle Dim an den Anfang des Scripts
- Einrückungen würden deinen Code besser lesbar machen
- es fehlt überall noch die Fehlerbehandlung (was ist wenn die erste Ansicht keinen Link enthält?, ....)
- GoTo machen den Code unübersichtlich

Gruß
Bernd

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

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

---

Danke Bernd!

              Ich werde versuchen, es wieder Dank für die Ratschläge, die sie immer gut und mehr erfahrene Leute.
              Merry Christmas and Happy Holidays.

Sobald Sie Antwort, die ich sage dir, aber nach den Ferien.

Ein Gruß

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

---

Hallo Bernd noch mal!

Ich habe versucht, den Code und gibt keine Fehler, sondern ich schreibe nur Daten "MATERIAL" und nicht von den ursprünglichen "ANCHO und DESIGNACION."

Dieser Lezte ("ANCHO und DESIGNACION")siehe BOM.

Vielen Dank

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

---

Servus
Dann setze dort einen Break-Point (im VBA-Ediotr) und lass dann den Code Schrittweise abarbeiten (Taste F8). Im Watch bzw Local-Fenster kannst du den Inhalt der Objekte verfolgen. Dann solltest du den Grund finden warum es bei den anderen Parameter nicht klappt (sind es auch Userparameter, stimmt der Name, ...)

Gruß
Bernd

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

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

---

Hallo nochmal!

Ich habe einige Änderungen an diesem Makro CATVBA gemacht und funktioniert perfekt, aber ich möchte, dass die Liste von oben nach unten ist und nicht, wie ich jetzt, wie soll ich tun? Vielen Dank.

Code:

---

Option Explicit
Sub CATMain()

'Declare Variables
Dim oDocument As Document
Dim oDrawingDoc As DrawingDocument
Dim oDrawingSheets As DrawingSheets
Dim oDrawingSheet As DrawingSheet
Dim oDrawingViews As DrawingViews
Dim oDrawingView As DrawingView
Dim oDrawingTables As DrawingTables
Dim oDrawingTable As DrawingTable
Dim oBackgroundView As DrawingView
Dim oProductDoc As ProductDocument
Dim oProducts As Products
Dim oProduct As Product
Dim TempProduct As Product
Dim QtyDict As Variant

'Compruebe que la ActiveDocument es un CATDrawing.
'Si no es así, informar al usuario y terminar la ejecución.

Set oDocument = CATIA.ActiveDocument
If Right(oDocument.FullName, 10) <> "CATDrawing" Then
MsgBox "Esta utilidad debe ejecutarse desde un CATDrawing."
Exit Sub
End If

'Variables publicas

Set oDrawingDoc = CATIA.ActiveDocument
Set oDrawingSheets = oDrawingDoc.Sheets
Set oDrawingSheet = oDrawingSheets.ActiveSheet
Set oDrawingViews = oDrawingSheet.Views
Set oDrawingView = oDrawingViews.Item(3)
Set oBackgroundView = oDrawingViews.Item("Background View")
Set oDrawingTables = oBackgroundView.Tables
Set oProductDoc = oDrawingView.GenerativeLinks.FirstLink.Parent
Set oProducts = oProductDoc.Product.Products
Set QtyDict = CreateObject("Scripting.Dictionary")

'Buscar a través de la estructura del CATProduct verificando la cantidad de cada componente.
'Añadir los componente en una lista de productos para su uso en el futuro.

Dim n As Integer
Dim ProductList() As Product
ReDim ProductList(oProducts.Count) 'Número total de productos.
Dim Index As Integer
Index = 1
For n = 1 To oProducts.Count
Set TempProduct = oProducts.Item(n)
If QtyDict.exists(TempProduct.PartNumber) = True Then
QtyDict.Item(TempProduct.PartNumber) = QtyDict.Item(TempProduct.PartNumber) + 1
Else
QtyDict.Add TempProduct.PartNumber, 1
Set ProductList(Index) = TempProduct
Index = Index + 1
End If
Next n

'Comprueba si una lista de materiales ya ha sido creada en el dibujo.
'Este código se utilizará cuando haya actualizaciones  necesarias en la lista de materiales.
'Si lista de materiales ya existe, se dirije al código que publica la lista de materiales.

For n = 1 To oDrawingTables.Count
Set oDrawingTable = oDrawingTables.Item(n)
If oDrawingTable.Name = "DrawingBOM" Then 'Verifica si existe la Tabla
Dim RowCount As Integer
If oDrawingTable.NumberOfRows > (QtyDict.Count) Then 'Borra las filas inecesarias.
For RowCount = (QtyDict.Count + 1) To oDrawingTable.NumberOfRows
    oDrawingTable.RemoveRow 2
Next RowCount
End If
    If oDrawingTable.NumberOfRows < (QtyDict.Count + 1) Then 'Añade filas necesarias.
    For RowCount = oDrawingTable.NumberOfRows To (QtyDict.Count)
    oDrawingTable.AddRow 2
    Next RowCount
    End If
GoTo POPULATEBOM 'Si la tabla existe
End If
Next n

'Si la tabla no existe, crear una etiqueta y lo mismo que el nombre de la tabla que se busca.

Set oDrawingTable = oDrawingTables.Add(404, 45, QtyDict.Count + 1, 6, 4.5, 10)
oDrawingTable.Name = "DrawingBOM" 'Etiqueta de la Tabla
oDrawingTable.AnchorPoint = CatTableBottomLeft 'Posicionamiento de la esquina inferior izquierda de la Tabla

'Filas publicadas en la BOM de la Tabla

POPULATEBOM:
'Texto de encabezado
'Call oDrawingTable.SetCellString(1, 1, "NºPieza")            'Definition
'Call oDrawingTable.SetCellString(1, 2, "Denominación")        'Description
'Call oDrawingTable.SetCellString(1, 3, "Cantidad")            'Qty
'Call oDrawingTable.SetCellString(1, 4, "Calidad Material")    'UserRefProperties "MATERIAL"
'Call oDrawingTable.SetCellString(1, 5, "Medidas [mm]")        'UserRefProperties "MEDIDAS"
'Call oDrawingTable.SetCellString(1, 6, "Peso[kg/ud]")        'UserRefProperties "PESO"

'Ancho de cabecera
Call oDrawingTable.SetColumnSize(1, 15)  'Definition
Call oDrawingTable.SetColumnSize(2, 72.5) 'Description
Call oDrawingTable.SetColumnSize(3, 14)  'Qty
Call oDrawingTable.SetColumnSize(4, 29.5) 'UserRefProperties "MATERIAL"
Call oDrawingTable.SetColumnSize(5, 31.5) 'UserRefProperties "MEDIDAS"
Call oDrawingTable.SetColumnSize(6, 17.5) 'UserRefProperties "PESO"

'Ancho de la ubicación.
For n = 1 To 6
Call oDrawingTable.SetCellAlignment(1, n, CatTableMiddleCenter) 'Centro de las Descripciones
Next n

'Utiliza la lista creada anteriormente con el fin de llenar la información de cada CATPart del CATProducto.
Dim i As Integer
Dim UserParameter As Parameter

For n = 2 To oDrawingTable.NumberOfRows

    'Llenar filas
Call oDrawingTable.SetCellString(n, 1, ProductList(n - 1).Definition)  'NºPieza
Call oDrawingTable.SetCellString(n, 2, ProductList(n - 1).DescriptionRef) 'Denominación
Call oDrawingTable.SetCellString(n, 3, QtyDict.Item(ProductList(n - 1).PartNumber)) 'Cantidad
Set UserParameter = UserparameterByName(ProductList(n - 1), "MATERIAL")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 4, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "MEDIDAS")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 5, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "PESO")
If Not UserParameter Is Nothing Then
    Call oDrawingTable.SetCellString(n, 6, UserParameter.ValueAsString)
End If

    'Justificar, posicionar filas
    For i = 1 To 2
   
        'Call oDrawingTable.SetCellAlignment(n, i, CatTableMiddleCenter) 'Centro 1 & 2
        Call oDrawingTable.SetCellAlignment(n, i + 2, CatTableMiddleCenter) 'Posicion derecha 3 & 4
        'Call oDrawingTable.SetCellAlignment(n, i + 2, CatTableMiddleLeft) 'Posicion derecha 3 & 4
        Call oDrawingTable.SetCellAlignment(n, i + 4, CatTableMiddleCenter) 'Posicion derecha 5 & 6
        'Call oDrawingTable.SetCellAlignment(n, i + 4, CatTableMiddleCenter) 'Posicion derecha 5 & 6
       
    Next i
Next n

End Sub

Function UserparameterByName(oProduct As Product, strParameter As String) As Parameter
    Dim UserParameters As Parameters
    Dim oParameter As Parameter
    Dim i As Integer

    Set UserParameters = oProduct.ReferenceProduct.UserRefProperties
    For i = 1 To UserParameters.Count
        Set oParameter = UserParameters.Item(i)
        If Right(oParameter.Name, Len(strParameter)) = strParameter Then
            Set UserparameterByName = oParameter
            Exit Function
        End If
    Next
 
    Set UserparameterByName = Nothing

End Function

---

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

---

Servus
ggf kannst du über

Code:

---

oDrawingTable.InvertMode(CatInvertRow)

---

invertieren, oder du musst in der Schleife über alle Zeilen die Werte aus der ProductList entsprechen ändern.

Gruß
Bernd

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

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

---

Hallo Bernd!

    Du bist der Beste, ich danke Ihnen sehr. Aber obwohl ich den Befehl verstehen (die ich ignoriert) Wie und wo ich fügen Sie das Makro?

Vielen Dank im Voraus.

M.f.G.

Manuel

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

---

Hi Manuel
Ich würde den Befehl mal am Ende (also nach Next n) einfügen.
If it easier for you, we could continue this conversation in English.

Gruß
Bernd

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

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

---

Hallo Bernd!

        Mein Deutsch ist schlecht, aber mein Englisch ist noch schlimmer, besser in deutscher Sprache und so habe ich besser als ich für meine Arbeit und Freizeit benötigen.

        Wenn ich verstehe, Sie kommentieren, dass ich nach dem "Next n" geben sollte, aber es gibt 4 oder 5 "Next n" Welche von ihnen?.

Vielen Dank

Manuel

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

---

Servus Manuel
Du solltest dein Makro besser kennen/verstehen als ich.
Wie wäre es wenn du die Zeile direkt von "End Sub" einfügst.

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. Wie Sie sagen, dass ich meinen Code besser wissen, aber haben mir die perfekte Lösung gegeben, jetzt kommt es als Liebe ab. Nur ein Problem, da ich den Kopftext entfernt gesehen habe.

Code:

---

POPULATEBOM:
'Texto de encabezado
'Call oDrawingTable.SetCellString(1, 1, "NºPieza")            'Definition
'Call oDrawingTable.SetCellString(1, 2, "Denominación")        'Description
'Call oDrawingTable.SetCellString(1, 3, "Cantidad")            'Qty
'Call oDrawingTable.SetCellString(1, 4, "Calidad Material")    'UserRefProperties "MATERIAL"
'Call oDrawingTable.SetCellString(1, 5, "Medidas [mm]")        'UserRefProperties "MEDIDAS"
'Call oDrawingTable.SetCellString(1, 6, "Peso[kg/ud]")        'UserRefProperties "PESO"

---

Aber jetzt lässt mich eine leere Zeile; Wie kann ich diese Zeile löschen?

Vielen Dank

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