Недавно появилась задача скрытия всех ограничений в сборке. Пока нашли два варианта решения, но ни один из них не работает полностью как надо:
Вариант 1: Выделяем корневую сборку (добавляем в Selection) и через Selection.Search ищем все ограничения запросом. После этого станут выделены все ограничения и тогда выполняем их скрытие:
- Код: Выделить всё
Sub Main()
Dim CatiaApp As Application
Dim ProdDoc As ProductDocument
Dim Prod As Product
Dim Sel As Selection
Set CatiaApp = GetObject(, "CATIA.Application")
Set ProdDoc = CatiaApp.ActiveDocument
Set Prod = ProdDoc.Product
Set Sel = ProdDoc.Selection
Sel.Clear
Sel.Search "(((((('Product Structure'.Constraint + FreeStyle.Constraint) + 'Assembly Design'.Constraint) + Sketcher.Constraint) + Drafting.Constraint) + 'Part Design'.Constraint) + 'Functional Molded Part'.Constraint);all"
' для русского языка интерфейса:
' Sel.Search "(((((('Структура изделия'.Ограничение + FreeStyle.Ограничение) + 'Проектирование сборок'.Ограничение) + 'Создание эскизов'.Ограничение) + Черчение.Ограничение) + 'Проектирование деталей'.Ограничение) + 'Functional Molded Part'.Ограничение);вез"
If Sel.Count2 > 0 Then
Sel.VisProperties.SetShow catVisPropertyNoShowAttr
Sel.Clear
End If
End Sub
В этом случае скрытие происходит не на всех сборках, может отрабатывать на одном ПК, а не работать на другом.
Вариант 2: Рекурсивно проходимся по всей сборке, и у каждой подсборки (если это CATProduct) получаем коллекцию Constraints. В коллекции по циклу перебираем все ограничения и добавляем в Selection. Потом все ограничения скрываем:
- Код: Выделить всё
Sub Main()
Dim CatiaApp As Application
Dim ProdDoc As ProductDocument
Dim Prod As Product
Dim Sel As Selection
Set CatiaApp = GetObject(, "CATIA.Application")
Set ProdDoc = CatiaApp.ActiveDocument
Set Prod = ProdDoc.Product
Set Sel = ProdDoc.Selection
Sel.Clear
Call ScanProductTree(Prod, 1)
If Sel.Count2 > 0 Then
Sel.VisProperties.SetShow catVisPropertyNoShowAttr
Sel.Clear
End If
End Sub
Public Sub ScanProductTree(ItemProd As Product, Level As Long)
Dim iDoc As Document
Dim iName As String
Dim pos As Long
Dim iExt As String
Dim constrCol As Constraints
Dim cn As Constraint
Dim n As Long
Dim i As Long
Set iDoc = ItemProd.ReferenceProduct.Parent
iName = iDoc.Name
pos = InStrRev(iName, ".", , vbTextCompare)
iExt = Right(iName, Len(iName) - pos)
If UCase(iExt) = "CATPRODUCT" Then
Set constrCol = ItemProd.Connections("CATIAConstraints")
If constrCol.Count > 0 Then
For i = 1 To constrCol.Count
Set cn = constrCol.Item(i)
Sel.Add cn
Next i
End If
End If
n = ItemProd.Products.Count
If n > 0 Then
For i = 1 To n
Call ScanProductTree(ItemProd.Products.Item(i), Level + 1)
Next i
End If
End Sub
В данном случае рекурсивная процедура проходит по всем подсборкам, получаются коллекции Constraints для каждой подсборки. Свойства коллекций считываются без ошибок, количество ограничений совпадает, но получение самих ограничений (Set cn = constrCol.Item(i) в коде) работает только для корневой сборки, а для всех остальных подсборок возникает ошибка "Индекс находится вне диапазона", хотя индекс корректен. Проверено на разных сборках. Получается что можно работать с ограничениями, которые находятся только в корневой сборке. И если подсборку открыть в новом окне (она станет корневой), то получение ограничений работает для данной подсборки.
Может кто-нибудь сталкивался с такой проблемой? Как можно получить ограничения сборки и всех её подсборок, находясь в корневой. Не открывать же каждую подсборку в новом окне. Спасибо.
