Снятие данных о позиции парта относительно верхней сборки

[ExtraRight]

Добрый день, коллеги

У меня уже всплывал похожий вопрос, но он видоизменился, поэтому пишу в отдельной теме (в старой теме мы в общем-то обсудили только как задавать позиционирование).

Необходимо программным кодом снять информацию о позиционировании парта относительно системы координат самой верхней сборки (сам парт может находиться в подсборке любого уровня относительно верхней).

Если код не очень сложный, то буду премногоблагодарен, если кто-либо из гуру приведёт пример кода.

[booSter]

Где-то так:

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

...
Dim prdTarget as Product
Set prdTarget =  ...
...
Dim posTarget as Position
Set posTarget = prdTarget.Position
Dim oPosComp(11)
posTarget.GetComponents oPosComp
Dim dblTM(2,2) as Double
Dim dblPV(2) as Double
' X components
dblTM(0,0) = oPosComp(0)
dblTM(0,1) = oPosComp(1)
dblTM(0,2) = oPosComp(2)
' Y components
dblTM(1,0) = oPosComp(3)
dblTM(1,1) = oPosComp(4)
dblTM(1,2) = oPosComp(5)
' Z components
dblTM(2,0) = oPosComp(6)
dblTM(2,1) = oPosComp(7)
dblTM(2,2) = oPosComp(8)
' V components
dblPV(0) = oPosComp(9)
dblPV(1) = oPosComp(10)
dblPV(2) = oPosComp(11)
...


[brigval]

На уровне идеи.
Ищем парт в последней сборке, прибавляем/отнимаем "позицию" в вышележащей сборке, прибавляем/отнимаем "позицию" в еще вышележащей сборке...Прибавляем/отнимаем "позицию" в верхней сборке. Если надо учитывать и угол поворота, то надо прибавлять/отнимать угол поворота. Видимо, тогда можно получить истиное смещение детали подсборки в верхней сборке относительно нуля верхней сборки.
Думаю, без рекурсии не обойтись. Она позволит автоматом пройти по всем подсборкам и выявить все составные части.

К сожалению, кодом посмочь не могу в виду его отсутствия. А сама задачка интересная.

[ExtraRight]

Где-то так:

Спасибо большое, уважаемому booSter за пример кода

У коллеги при попытке компиляции в Visual Basic вылетает ошибка (см. картинку) - или этот код не для VB писан?

[booSter]

Проверь значение

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

Option Base 0

если использовалось

и попробуй вместо

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

dblTM(0,0) = oPosComp(0)

использовать

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

dblTM(0,0) = CDbl( oPosComp(0) )

[ExtraRight]

Спасибо, коллега завтра попробует

[booSter]

Функция GetComponents имеет in/out параметр типа CATSafeArrayVariant, который с VBA не очень дружит
Явное приведение обычно помогает.

[ExtraRight]

Коллега соообщает об ошибке:

Проблема в том, что при отработке макроса ошибок нет, но в создавшемся файле (.txt) получается:
1
0
0
0
1
0
0
0
1
Не смотря на то что модель позиционирована относительно «0».
Никак не можем понять в чем мы ошиблись!

Пример кода:

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

Set productDocument1 = CATIA.ActiveDocument
Dim PName As String
Dim Temp() As String
Dim i As Integer
Dim TempName As String
Dim posTarget, OBJ As Object
Dim oPosComp(11) As Variant
ReDim Temp(0)
Set CurrentProduct = productDocument1.Product
Set posTarget = CurrentProduct.Position
posTarget.GetComponents oPosComp

MyPath = "c:\temp\txt" 'путь до директории с папками в кторых лежат файлы с позициями деталей
If Dir(MyPath & "\" & CurrentProduct.PartNumber, vbDirectory) = "" Then
  MkDir MyPath & "\" & CurrentProduct.PartNumber
End If
MyPath = MyPath & "\" & CurrentProduct.PartNumber
Open MyPath & "\" & CurrentProduct.PartNumber & ".txt" For Output Shared As #1
For i = 0 To 11
Print #1, oPosComp(i)
Next i
Close #1
Temp(0) = CurrentProduct.PartNumber

Dim Y, Count As Integer
Y = 1
Do While Y > 0
 Y = Y - 1
 Count = CurrentProduct.Products.Count
 ReDim Preserve Temp(Y + Count)
 'ReDim Preserve Temp_obj(Y + Count)
 k = 0
 For i = 1 To Count
   Set OBJ = CurrentProduct.Products.Item(i)
   On Error Resume Next
   Temp(Y + i - k) = OBJ.PartNumber
   'Temp(Y + i - k) = OBJ.PartNumber
   If Err <> 0 Then
    ReDim Preserve Temp(UBound(Temp, 1) - 1)
    k = k + 1
   End If
   'Set Temp_obj(Y + Count - i + 1) = CurrentProduct.Products.Item(i)
 Next i
 Y = Y + Count - k
next_c:  If Y > 0 Then
   TempName = Temp(UBound(Temp, 1))
   'On Error GoTo model
    On Error Resume Next
   Set CurrentProduct = productDocument1.GetItem(TempName)
   If Err <> 0 Then
    ReDim Preserve Temp(UBound(Temp, 1) - 1)
    TempName = Temp(UBound(Temp, 1))
    Y = Y - 1
    GoTo next_c
   End If
   Set posTarget = CurrentProduct.Position
   posTarget.GetComponents oPosComp
   Open MyPath & "\" & CurrentProduct.PartNumber & ".txt" For Output Shared As #1
     For i = 0 To 11
       Print #1, oPosComp(i)
       If oPosComp(i) <> 1 And oPosComp(i) <> 0 Then
       l = 0
       End If
     Next i
   Close 

[booSter]

Проанализировал код "наискосок":
Загадка №1: Цикл вывода в файл от 0 до 11, а строчек - 9
Отгадка №2: Первые 9 чисел это матрица, задающая повороты, и если их нет, то матрица единичная
Отгадка №3: 3 последних числа - вектор смещения
Загадка №4: Нужно разобраться в каком контекстные отдаётся позиция, ну и предпринять действия по коррекции если это необходимо

[ExtraRight]

Спасибо, бум разбираться, где накосячили