Autor
|
Thema: BOM NACH Drawing VBA (4971 mal gelesen)
|
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 20. Dez. 2011 21:11 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 20. Dez. 2011 22:06 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 22. Dez. 2011 08:12 <-- editieren / zitieren --> Unities abgeben:
|
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Dez. 2011 08:27 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 22. Dez. 2011 08:57 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Dez. 2011 15:06 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 = NothingEnd Function
Der Aufruf würde dann zB so erfolgen:
Code: Dim UserParameter As ParameterSet 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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 22. Dez. 2011 15:28 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 22. Dez. 2011 15:45 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 23. Dez. 2011 08:22 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 23. Dez. 2011 10:32 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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übersichtlichGruß Bernd ------------------ Warum einfach, wenn es auch kompliziert geht. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 23. Dez. 2011 10:41 <-- editieren / zitieren --> Unities abgeben:
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 23. Dez. 2011 10:49 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 23. Dez. 2011 10:56 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 23. Aug. 2016 22:01 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 23. Aug. 2016 22:20 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 24. Aug. 2016 07:48 <-- editieren / zitieren --> Unities abgeben:
|
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 24. Aug. 2016 09:59 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 24. Aug. 2016 12:58 <-- editieren / zitieren --> Unities abgeben:
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 |
bgrittmann Moderator Konstrukteur
Beiträge: 11780 Registriert: 30.11.2006 CATIA V5R19
|
erstellt am: 24. Aug. 2016 13:56 <-- editieren / zitieren --> Unities abgeben: Nur für xyon126
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 |
xyon126 Mitglied Ingenieur
Beiträge: 74 Registriert: 07.11.2011
|
erstellt am: 25. Aug. 2016 07:18 <-- editieren / zitieren --> Unities abgeben:
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 |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|