Code:
'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.ThisComponent.CurrentController.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, 40, 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:
'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, 6, UserParameter.ValueAsString)
End If
Set UserParameter = UserparameterByName(ProductList(n - 1), "MEDIDAS")
If Not UserParameter Is Nothing Then
Call oDrawingTable.SetCellString(n, 6, 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
oDrawingTable.InvertMode (CatInvertRow)
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
Foren auf CAD.de (alle Foren)
| 
