---

Hello Team

I'm trying to write small scsript which will extract some infos from exisiting CATIA Assembly structure, like Part Name, Description, Type, CoG, Mass, Density and Material.
Assumption are:
1. Material on the parts could be applied on the Part (Product) or on the body itself, so it has to be working on both cases
2. For the subassemblies, there is no Material aplied/mixed materials, thus fr those there is comment "{Mixed}" in
3. For the same reason - the density is not checked for those cases

Here's what I've got s far:

Code:

---

Sub CATMain()
    Dim CATIAApp As Application
    Set CATIAApp = CATIA

    Dim productDoc As ProductDocument
    Set productDoc = CATIAApp.ActiveDocument
    Dim rootProduct As Product
    Set rootProduct = productDoc.Product

    ' Start Excel
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    Dim xlWorkbook As Object
    Set xlWorkbook = xlApp.Workbooks.Add

    Dim xlSheet As Object
    Set xlSheet = xlWorkbook.Sheets(1)

    ' Headers
    xlSheet.Cells(1, 1).Value = "PartNumber"
    xlSheet.Cells(1, 2).Value = "Type"
    xlSheet.Cells(1, 3).Value = "Description"
    xlSheet.Cells(1, 4).Value = "Mass (kg)"
    xlSheet.Cells(1, 5).Value = "CoG X (mm)"
    xlSheet.Cells(1, 6).Value = "CoG Y (mm)"
    xlSheet.Cells(1, 7).Value = "CoG Z (mm)"
    xlSheet.Cells(1, 8).Value = "Density"
    xlSheet.Cells(1, 9).Value = "Material"

    Dim rowIndex As Integer
    rowIndex = 2

    Call TraverseProduct(rootProduct, xlSheet, rowIndex)
    MsgBox ("Gotowe!")
End Sub

Sub TraverseProduct(ByVal prod As Product, ByRef xlSheet As Object, ByRef rowIndex As Integer)

    Dim i As Integer
    For i = 1 To prod.Products.Count
        Dim subProd As Product
        Set subProd = prod.Products.Item(i)

            If Not subProd.Definition = "MASTER" Then
                Dim partType As String
                partType = IIf(subProd.Products.Count > 0, "Assembly", "Part")
       
                Dim mass As Double, cogX As Double, cogY As Double, cogZ As Double
                Dim oCoords(2)
                If TypeName(subProd.ReferenceProduct.Parent) = "PartDocument" Then
                    Dim subPart As Part
                    Set subPart = subProd.ReferenceProduct.Parent.Part
                    Dim density As String
                    Dim material As String
                    density = subPart.density
                    Dim oMatMan As MaterialManager
                    Set oMatMan = subPart.GetItem("CATMatManagerVBExt")
                    Dim oMat As material
                    oMatMan.GetMaterialOnPart subPart, oMat
                    material = oMat.Name
                Else
                    density = ""
                    material = "{Mixed}"
                End If
                On Error Resume Next
                Dim inertia 'As inertia
                Set inertia = subProd.GetTechnologicalObject("Inertia")
                inertia.GetCOGPosition oCoords
                If Not inertia Is Nothing Then
                    mass = inertia.mass
                    cogX = oCoords(0)
                    cogY = oCoords(1)
                    cogZ = oCoords(2)
                End If

                On Error GoTo 0
       
                xlSheet.Cells(rowIndex, 1).Value = subProd.PartNumber
                xlSheet.Cells(rowIndex, 2).Value = subProd.Definition
                xlSheet.Cells(rowIndex, 3).Value = subProd.DescriptionRef
                xlSheet.Cells(rowIndex, 4).Value = mass
                xlSheet.Cells(rowIndex, 5).Value = cogX * 1000
                xlSheet.Cells(rowIndex, 6).Value = cogY * 1000
                xlSheet.Cells(rowIndex, 7).Value = cogZ * 1000
                xlSheet.Cells(rowIndex, 8).Value = density
                xlSheet.Cells(rowIndex, 9).Value = material
               
                rowIndex = rowIndex + 1
       
                ' Recurse into sub-assemblies
                If subProd.Products.Count > 0 Then
                    Call TraverseProduct(subProd, xlSheet, rowIndex)
                End If
            End If
    Next i
End Sub

---

Basically it does what I want, except I can't get applied material name  and I run out f ideas. Can someone help me to figure out what's wrong with it?

Thanks in advance

Lucas

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

---

Hi Lucas

This works for me:

Code:

---

'get Material of Part first
oMatMan.GetMaterialOnPart subPart, oMat
If oMat is Nothing then
    'Get material on mainbody second
    oMatMan.GetMaterialOnBody SubPart.Mainbody, oMat
End if

If oMat is Nothing then
    Msgbox "No Material found"
Else
    MsgBox oMat.Name
End if

---

Regards,
Bernd

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

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