pls correct the code .macro for assembling bodies 1

[enigmabindra]

Here is the script....its working...but if 3 bodies r there
then it is assembling 2nd body 2times and
not assembling the 3rd body. Anybody pls correct
the script. Thanks in advance...
Sub CATMain()

Dim partDocument1 As Document

On Error Resume Next

Set partDocument1 = CATIA.ActiveDocument

If Err.Number <> 0 Then

MsgBox "Open a CATPart first!!!", vbCritical, "Error"

Exit Sub

End If



Dim part1 As Part

On Error Resume Next

Set part1 = partDocument1.Part

If Err.Number <> 0 Then

MsgBox "This macro is good only for a CATPart!!!", vbCritical, "Error"

Exit Sub

End If



Dim Bodies1 As Bodies

Set bodies1 = part1.Bodies



n = bodies1.Count



Dim body1 As Body

Set body1 = bodies1.Item("PartBody")'The fisrt body of my CATPart



Dim shapeFactory1 As Factory

Set shapeFactory1 = part1.ShapeFactory



Dim i As Integer

For i = 2 To n

part1.InWorkObject = body1

Dim body2 As Body

Set body2 = bodies1.Item(i)

'~ MsgBox body2.Name

Dim assemble1 As Assemble

Set assemble1 = shapeFactory1.AddNewAssemble(body2)

Next



part1.UpdateObject assemble1



'~ MsgBox "Finish"





Part1.Update



Dim specsAndGeomWindow1 As Window

Set specsAndGeomWindow1 = CATIA.ActiveWindow



Dim viewer3D1 As Viewer

Set viewer3D1 = specsAndGeomWindow1.ActiveViewer



Dim viewpoint3D1 As Viewpoint3D

Set viewpoint3D1 = viewer3D1.Viewpoint3D



viewer3D1.Reframe



Set viewpoint3D1 = viewer3D1.Viewpoint3D



Set body1 = Bodies1.Item("PartBody")                        

Part1.InWorkObject = Body1



End Sub

 

[ferdo]

Hi,

A picture is worth a thousand words - better upload a picture how you want to be the result after running macro and even better, try first to record a macro doing manually what you want.

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[ferdo]

Did you tried something?

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[enigmabindra]

Thnk u ferdo....i tried with macro recording..It works for me...but actully what I want was with a loop.I will show the screen shots...

 

[enigmabindra]

Thnk u ferdo....i tried with macro recording..It works for me...but actully what I want was with a loop.I will show the screen shots...

 

[ferdo]

Hi,

Bellow code is just recorded and cleaned a lit bit...I believe now is easier to create a loop for how many bodies you want. If you notice, you can create a separate function to insert and assemble a body then repeat how many times you want, what is bellow is inserting first all bodies then assemble them.

Language="VBSCRIPT"
Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Add()
Dim body2 As Body
Set body2 = bodies1.Add()
Dim body3 As Body
Set body3 = bodies1.Add()

Dim body4 As Body
Set body4 = bodies1.Item("PartBody")

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory

part1.InWorkObject = body4
Dim assemble1 As Assemble
Set assemble1 = shapeFactory1.AddNewAssemble(body1)

part1.InWorkObject = body4
Dim assemble2 As Assemble
Set assemble2 = shapeFactory1.AddNewAssemble(body2)

part1.InWorkObject = body4
Dim assemble3 As Assemble
Set assemble3 = shapeFactory1.AddNewAssemble(body3)

part1.Update 
part1.InWorkObject = body4

End Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[ferdo]

If you want in a loop then you can use something like this

Language="VBSCRIPT"
Sub CATMain()

Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body_main As Body
Set body_main = bodies1.Item("PartBody")

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory

bodies_nr = InputBox("Write the number of bodies to be inserted and assembled", "Loop")

    For i = 1 To bodies_nr
        Dim body1 As Body
        Set body1 = bodies1.Add()
        part1.InWorkObject = body_main
        Dim assemble1 As Assemble
        Set assemble1 = shapeFactory1.AddNewAssemble(body1)
    Next

part1.Update 
part1.InWorkObject = body_main

End Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/

 

[enigmabindra]

I am really sorry Ferdo....I want the output tree should be like this.....screen shot

 

[ferdo]

No problem, so, you have to insert a pocket operation inside the loop

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

https://picasaweb.google.com/103462806772634246699/