Компоненты сборки

[lexincton]

Как пробежаться по структуре сборки с подсчетом входящих компонентов?

[Wireless_Fidelity]

Самое простое - использовать Selection (метод Search "'Assembly Design'.Product,all")
Более правильное - сделать рекурсивный обход через коллекции Products.

Для каких целей нужен список?

[lexincton]

Самое простое - использовать Selection (метод Search "'Assembly Design'.Product,all")
Более правильное - сделать рекурсивный обход через коллекции Products.

Для каких целей нужен список?

Пока для создания списка в нужном формате, в search попробую!
А про коллекции можно поподробнее, как например правильно подсчитать кол-во одиннаковых деталей в сборке? можно хотя бы пример кода?

[VladimirK]

Здравствуйте! Недавно столкнулся с подобной задачей, только ещё находил сами файлы подсборок и деталей.
Для этого рекурсивно прошёл сборку - нашёл все объекты Product и связанные с ними файлы.
Потом по расширению определил сборки и детали. Ниже приведён пример на Delphi.
Для начала обхода дерева нужно вызвать процедуру ScanProductTree(ProdDoc.Product, 1).

Код: Выделить всё

function LeftStr(Const Str: String; Size: Word): String;
begin
  LeftStr := Copy(Str, 1, Size)
end;

function RightStr(Const Str: String; Size: Word): String;
begin
  if Size > Length(Str) then Size := Length(Str);
  RightStr := Copy(Str, Length(Str)-Size+1, Size)
end;

procedure ScanProductTree(ItemProd: Product; Level: Integer);
var
  n, i: Integer;
  iVar: OleVariant;
  iDoc: Document;
  fName: String;
  fExt: String;
begin
  iDoc := ItemProd.ReferenceProduct.Parent as Document;
  fName := iDoc.Get_Name(); // имя файла с расширением
  fExt := RightStr(fName, Length(ExtractFileExt(fName))-1);
  fName := LeftStr(fName, Length(fName) - Length(ExtractFileExt(fName))); // имя файла без расширения

  if UpperCase(fExt) = 'CATPART' then
    begin
      //MessageDlg('ItemProd - CATPART', mtInformation, [mbOK], 0);
      // Действия если ItemProd - CATPART
    end
  else if UpperCase(fExt) = 'CATPRODUCT' then
    begin
      //MessageDlg('ItemProd - CATPRODUCT', mtInformation, [mbOK], 0);
      // Действия если ItemProd - CATPRODUCT
    end;
  n := ItemProd.Products.Count;
  if n > 0 then
    begin
      for i := 1 to n do
      begin
        iVar := OleVariant(i);
        ScanProductTree(ItemProd.Products.Item(iVar), Level + 1);
      end;
    end;
end;


[Wireless_Fidelity]

У "одинаковых" деталей в свойстве ReferenceProduct будет стоять один и тот же продукт.

Привожу пример рекурсивного обхода с выгрузкой структуры дерева в Excel:

Код: Выделить всё

Option Explicit

Sub CATMain()

    ' get root product of active document
    Dim prdRoot As Product
    On Error Resume Next
        Set prdRoot = CATIA.ActiveDocument.Product
       
    If (Err.Number <> 0) Then
        Err.Clear
        MsgBox "Can't get root product. Check document type"
        Exit Sub
    End If
   
    ' launch Excel
    Dim oExcel As Object
    On Error Resume Next
        Set oExcel = CreateObject("Excel.Application")
   
    If (Err.Number <> 0) Then
        Err.Clear
        MsgBox "Can't start Excel. Check if it was properly registered as COM"
        Exit Sub
    End If
   
    ' create a workbook and get a sheet from it
    Dim oExcelSheet As Object
    Set oExcelSheet = EXCEL.Workbooks.Add().ActiveSheet
   
    oExcel.Visible = True
   
   
    ' export product structure to Excel starting from first row and first column
    ExportProductStructure prdRoot, oExcelSheet, 1, 1
 

End Sub

Sub ExportProductStructure(prdRoot, oExcelSheet, iRow, iColumn)

    '------------------------------------
    ' WRITE NAME OF ROOT PRODUCT IN EXCEL
    '------------------------------------
    'oExcelSheet.Cells(iRow, iColumn) = prdRoot.Name
    oExcelSheet.Cells(iRow, iColumn) = prdRoot.PartNumber
   
    '---------------------------
    ' GET LIST OF CHILD PRODUCTS
    '---------------------------
    ' go through all products of previous level
    Dim iNbChildren
    iNbChildren = prdRoot.Products.Count
   
    ' make sure that we continue expanding product on the current row
    If (iNbChildren > 0) Then
        iRow = iRow - 1
    End If
   
    Dim prdChild As Product
    Dim iChild
   
    iColumn = iColumn + 1
    For iChild = 1 To iNbChildren
        ' get another child product
        Set prdChild = prdRoot.Products.Item(iChild)
       
        '---------------
        ' RECURSIVE CALL
        '---------------
        iRow = iRow + 1
       
        ExportProductStructure prdChild, oExcelSheet, iRow, iColumn
                 
    Next
   
    ' return back to previous level
    iColumn = iColumn - 1
    'iRow = iRow - 1
       
End Sub

[lexincton]

Большое спасибо!

[lexincton]

У "одинаковых" деталей в свойстве ReferenceProduct будет стоять один и тот же продукт.

Привожу пример рекурсивного обхода с выгрузкой структуры дерева в Excel:

Код: Выделить всё

Option Explicit

Sub CATMain()

    ' get root product of active document
    Dim prdRoot As Product
    On Error Resume Next
        Set prdRoot = CATIA.ActiveDocument.Product
       
    If (Err.Number <> 0) Then
        Err.Clear
        MsgBox "Can't get root product. Check document type"
        Exit Sub
    End If
   
    ' launch Excel
    Dim oExcel As Object
    On Error Resume Next
        Set oExcel = CreateObject("Excel.Application")
   
    If (Err.Number <> 0) Then
        Err.Clear
        MsgBox "Can't start Excel. Check if it was properly registered as COM"
        Exit Sub
    End If
   
    ' create a workbook and get a sheet from it
    Dim oExcelSheet As Object
    Set oExcelSheet = EXCEL.Workbooks.Add().ActiveSheet
   
    oExcel.Visible = True
   
   
    ' export product structure to Excel starting from first row and first column
    ExportProductStructure prdRoot, oExcelSheet, 1, 1
 

End Sub

Sub ExportProductStructure(prdRoot, oExcelSheet, iRow, iColumn)

    '------------------------------------
    ' WRITE NAME OF ROOT PRODUCT IN EXCEL
    '------------------------------------
    'oExcelSheet.Cells(iRow, iColumn) = prdRoot.Name
    oExcelSheet.Cells(iRow, iColumn) = prdRoot.PartNumber
   
    '---------------------------
    ' GET LIST OF CHILD PRODUCTS
    '---------------------------
    ' go through all products of previous level
    Dim iNbChildren
    iNbChildren = prdRoot.Products.Count
   
    ' make sure that we continue expanding product on the current row
    If (iNbChildren > 0) Then
        iRow = iRow - 1
    End If
   
    Dim prdChild As Product
    Dim iChild
   
    iColumn = iColumn + 1
    For iChild = 1 To iNbChildren
        ' get another child product
        Set prdChild = prdRoot.Products.Item(iChild)
       
        '---------------
        ' RECURSIVE CALL
        '---------------
        iRow = iRow + 1
       
        ExportProductStructure prdChild, oExcelSheet, iRow, iColumn
                 
    Next
   
    ' return back to previous level
    iColumn = iColumn - 1
    'iRow = iRow - 1
       
End Sub

А каким образом из этих product извлечь document?

[Wireless_Fidelity]

Из каких именно? Посмотрите документацию, родительский элемент любого объекта доступен через свойство Parent.

[lexincton]

Из каких именно? Посмотрите документацию, родительский элемент любого объекта доступен через свойство Parent.

Спасибо огромное за подсказку! Все получилось!