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

发布日期:2025-02-02 05:44:25     作者:心碎了无痕     手机:https://m.xinb2b.cn/sport/inc141858.html     违规举报

主程序: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

示例:


 
 
本文地址:https://xinb2b.cn/sport/inc141858.html,转载请注明出处。

推荐图文
推荐运动知识
网站首页  |  关于我们  |  联系方式  |  使用协议  |  版权隐私  |  网站地图  |  违规举报  |  蜀ICP备18010318号-4  |  百度地图  | 
Processed in 0.045 second(s), 1 queries, Memory 0.57 M