主程序:RemoveInactivate

遍历程序:GetDeactived

执行程序:RemoveDeactived范围:已选择的产品或零部件及其子级

Public Sub RemoveInactivate()

CATIA.DisplayFileAlerts = False

Dim Selection1 'As Selection

Set Selection1 = CATIA.ActiveDocument.Selection

Selection1.Clear

Dim InputObjectType(0)

InputObjectType(0) = "Product"

Selection1.SelectElement2 InputObjectType, "Select a Component", False

GetDeactived Selection1.Item(1).Value

CATIA.ActiveDocument.product.Update

CATIA.DisplayFileAlerts = True

End Sub

遍历目标对象

Private Sub GetDeactived(ByVal oSubProd As product)

' On Error Resume Next

Dim jj As Integer

Dim oSubProds As products

Set oSubProds = oSubProd.products

RemoveDeactived oSubProds

For jj = 1 To oSubProds.Count

RemoveDeactived oSubProds.Item(jj).products

If Not oSubProds.Item(jj).HasAMasterShapeRepresentation() Then

Dim oSubSubProds As products

Set oSubSubProds = oSubProds.Item(jj).products

If oSubSubProds.Count > 0 Then

Call GetDeactived(oSubProds.Item(jj))

End If

End If

Next

End Sub

移除非激活的对象

Private Sub RemoveDeactived(ByVal oSubProds As products)

On Error Resume Next

Dim parameter As parameter, parameters2 As parameters

Dim i As Integer

For i = 1 To oSubProds.Count

Set parameters2 = oSubProds.Item(i).parameters.subList(oSubProds.Item(i), False)

Set parameter = parameters2.Item(1)

If parameter.ValueAsString = "false" Then

parameter.ValuateFromString "true"

oSubProds.Remove oSubProds.Item(i).Name

End If

Next

End Sub

示例:

catia怎么用vba获取拓扑面的面积(CATIA二次开发VBA)(1)

,