CATIA MACRO TO CREATE EACH BODY AS A PART 1

[bratosinmihai]

Hi everybody,

I found a macro which generate each body from one catpart in separate catpart inside new product , 1 body= 1 catpart
I tried to modify this vbscript for what I need but doesn t work
I want to select bodies which I need with "tools pallete", no all bodies from catpart ( see photo 1) and then
I need to copy them and paste in product selected by me,existent one, no a new product, (see photo 2)

Is there someone to help me to resolve this problem???

Language = "VBSCRIPT"

Dim KomponenteNeu As products
Dim KoerperName
Dim OpenKoerperName
Dim hybridBodies As document
Dim Koerper As Object
Dim QuellFenster As Window
Dim Letztekoerper
Dim UserSel As Selection


Sub CATMain()

Dim Activdocu As document
Set Activdocu = CATIA.ActiveDocument

'---------------------------------------------------
' Neue Product
'---------------------------------------------------
Dim PosString As Long

partName = CATIA.ActiveDocument.Name

Dim docu As Documents
Set docu = CATIA.Documents

Dim productDocu As document
Set productDocu = docu.Add("Product")

Dim ProductNeu As Product
Set ProductNeu = productDocu.Product

PosString = InStr(1, partName, ".CATPart")
ProductNeu.PartNumber = Mid(partName, 1, PosString - 1)
'------------------------------------------------------

FensterNebeneinander

Set QuellFenster = CATIA.Windows.Item(1)
QuellFenster.Activate

Dim partBodies As Bodies
'Set Activdocu = CATIA.ActiveDocument
Set partBodies = Activdocu.Part.Bodies

Dim koerperAnzahl
koerperAnzahl = partBodies.Count

Dim UserSel As Object
For I = 1 To koerperAnzahl

Set Koerper = partBodies.Item(I)
KoerperName = Koerper.Name

If Right(KoerperName, 1) = "\" Then
KoerperName = Left(KoerperName, Len(KoerperName) - 1)
End If

KoerperName = Replace(KoerperName, "\", "_")

'Koerper kopieren
Activdocu.Selection.Clear
Activdocu.Selection.Add Koerper
Activdocu.Selection.Copy
Activdocu.Selection.Clear

'Part erzeugen und Koerper einfuegen
Dim PartNeu As Product
Set PartNeu = ProductNeu.products.AddNewComponent("Part", CStr(KoerperName))

' Fenster mit neue Product activieren
ProductNeu.parent.Activate

' Alle Parts suchen
PartSuchen ProductNeu.parent, UserSel

'ProductNeu.parent.Selection.Clear
'ProductNeu.parent.Selection.Add UserSel.Item(UserSel.Count).Value
ProductNeu.Parent.Selection.Clear
ProductNeu.Parent.Selection.Add ProductNeu.products.Item(PartNeu).ReferenceProduct.Parent.Part
ProductNeu.parent.Selection.PasteSpecial "CATPrtResult"
ProductNeu.parent.Selection.Clear

Next

Dim hybridBodies As hybridBodies
'Set Activdocu = CATIA.ActiveDocument
Set hybridBodies = Activdocu.Part.hybridBodies

koerperAnzahl = hybridBodies.Count

For I = 1 To koerperAnzahl

Set Koerper = hybridBodies.Item(I)
KoerperName = Koerper.Name

If Right(KoerperName, 1) = "\" Then
KoerperName = Left(KoerperName, Len(KoerperName) - 1)
End If

KoerperName = Replace(KoerperName, "\", "_")

'Koerper kopieren
Activdocu.Selection.Clear
Activdocu.Selection.Add Koerper
Activdocu.Selection.Copy
Activdocu.Selection.Clear

'Part erzeugen und Koerper einfuegen
Set PartNeu = ProductNeu.products.AddNewComponent("Part", CStr(KoerperName))

' Fenster mit neue Product activieren
ProductNeu.parent.Activate

' Alle Parts suchen
PartSuchen ProductNeu.parent, UserSel

'ProductNeu.parent.Selection.Clear
'ProductNeu.parent.Selection.Add UserSel.Item(UserSel.Count).Value
ProductNeu.Parent.Selection.Clear
ProductNeu.Parent.Selection.Add ProductNeu.products.Item(PartNeu).ReferenceProduct.Parent.Part
ProductNeu.parent.Selection.Paste
ProductNeu.parent.Selection.Clear

Next

' Product actualisieren
ProductNeu.ApplyWorkMode DESIGN_MODE
On Error Resume Next
ProductNeu.Update
If Err <> 0 Then
MsgBox "Problem with update!" & vbLf & vbLf & "Please update manual!", vbCritical + vbOKOnly, "Update-Error"
End If
On Error GoTo 0

End Sub


Sub PartSuchen(oPartDoc1, UserSel)

Dim E As Object 'CATBSTR
Dim Was(0)
Was(0) = "Part"

'Dim UserSel As Object
Set UserSel = oPartDoc1.Selection
UserSel.Clear

'Let us first fill the CSO with all the objects of the model
UserSel.Search ("CATPrtSearch.PartFeature,all")

'E = UserSel.SelectElement2(Was, "Alle CATPart wählen", True)
'Letztekoerper = UserSel.Count

End Sub


Sub FensterNebeneinander()

Dim windows1 As Windows
Set windows1 = CATIA.Windows

windows1.Arrange catArrangeTiledVertical

End Sub

 

[cilici]

Hello,

1.To run only on your selection, create a new collection, add all bodies from your selection and modify the script to run only inside your collection (not on all bodies).
something like this:
Dim myBodies as Collection
Set myBodies = new Collection
for i=1 to myPartDocument.Selection.Count

myBodies.add myPartDocument.Selection.Item(i).Value​

next
'then parse this collection
myPartDocument.Selection.Clear
for each myBody in myBodies

'copy-paste, bla bla bla​

next

2.For the other question, there are many options: use SelectElement4 method or use an inputbox for the user with all ProductDocuments opened in your session, or just hard code it.

Now, I hope it helps although I suspect you are not familiar with scripting in V5 at all.

Calin

 

[bratosinmihai]

Thanks for answer. Yes I am not familiar with vbscript but I am reading about it for two weeks.

 

[Macro2015]

similar macro can be found here link

 

[ferdo]

Also here .

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

- Romania

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

- EU

 

[mousepotato]

@Ferdo..
You are wicked..