CATIA Macro将主体添加到新主体中

时间:2015-01-19 18:37:01

标签: vba excel-vba catia excel

我想编写一个将选择的宏:

  • 所有名为“name_1”的机构,并将其添加到名为“new group 1”
  • 的新机构
  • 所有名为“name_2”的机构,并将其添加到名为“new group 2”
  • 的新机构
  • 所有机构都命名为“name_3”,并将它们添加到名为“new group 3”的新机构

我在CATIA R20上成功编写了这段代码,工作正常。它增加了新身体的所有身体。 但后来我尝试在CATIA R19和R24上运行一个宏,但它不起作用!在R19 / R24中,它不会添加名为“name_1”的所有物体,但它只在新体中添加一个物体!

Sub CATMain()
    Dim partDocument1 As PartDocument    
    Set partDocument1 = CATIA.ActiveDocument    
    Set objSel = partDocument1.Selection

    Dim part1 As Part    
    Set part1 = partDocument1.Part
    Dim bodies1 As Bodies    
    Set bodies1 = part1.Bodies

    Set shapeFactory1 = part1.ShapeFactory    
    Set bodies1 = part1.Bodies    
    Dim body1 As Body    
    Set body1 = bodies1.Item("PartBody")    
    Dim shapes1 As Shapes    
    Set shapes1 = body1.Shapes    
    objSel.Clear

    '******************name_1*********************    
    objSel.Search ("Name=name_1,all")    
    objcount = objSel.Count    

    Set body1 = bodies1.Add()    
    body1.Name = "new_name_1"

    Set body1 = bodies1.Item("new_name_1")
    part1.InWorkObject = body1

    For i = 1 To objcount
    Set body11 = bodies1.Item("name_1")
    Set add1 = shapeFactory1.AddNewAdd(body11)
    Next
    objSel.Clear

End Sub

1 个答案:

答案 0 :(得分:0)

在Catia中,如果您有多个具有相同名称的功能,Catia只能识别第一个功能。所以当你:

Set body11 = bodies1.Item("name_1")

您之前搜索过所有名为“name_1”的实体,如果有多个实体,则仅搜索第一个实体。

所以我会这样做:

Sub CATMain()
Dim partDocument1 As PartDocument    
Set partDocument1 = CATIA.ActiveDocument    
Set objSel = partDocument1.Selection

Dim part1 As Part    
Set part1 = partDocument1.Part
Dim bodies1 As Bodies    
Set bodies1 = part1.Bodies

Dim cBodies as new collection

Set shapeFactory1 = part1.ShapeFactory    
Set bodies1 = part1.Bodies    
Dim body1 As Body    
Set body1 = bodies1.Item("PartBody")    
Dim shapes1 As Shapes    
Set shapes1 = body1.Shapes    
objSel.Clear

'******************name_1*********************    
objSel.Search ("Name=name_1,all")    
objcount = objSel.Count    

'Check if search found something
If objcount > 0 then
    'add selected objects to a collection
     For i = 1 To objcount
        cBodies.Add objSel.Item(i).value
     next
     objSel.clear

     Set body1 = bodies1.Add()    
     body1.Name = "new_name_1"

    'Set body1 = bodies1.Item("new_name_1") 'You dont need to do this because you set it 3 lines up
    'part1.InWorkObject = body1 'Not needed, Any new feature will automatically be the inworkobject

For i = 1 To objcount
    Set add1 = shapeFactory1.AddNewAdd(cBodies1.Item(i))
Next

part1.UpdateObject body1 'Update the body

End if

End Sub