Convertir un CATPart en CATProduct
3 participants
Page 1 sur 1
Convertir un CATPart en CATProduct
Bonjour,
J'ai reçu un fichier AllCATPart (c'est à dire créé depuis un CATProduct en créant un corps de pièce pour chaque CATPart...)
Je voudrais savoir s'il existe une commande/macro/script pour créer un CATPart à partir de chaque corps de pièces de mon AllCATPart?
En bref, j'ai un CATPart composé de n corps de pièces que je souhaite transformer en :
un CATProduct avec n CATPart
merci d'avance,
JER
J'ai reçu un fichier AllCATPart (c'est à dire créé depuis un CATProduct en créant un corps de pièce pour chaque CATPart...)
Je voudrais savoir s'il existe une commande/macro/script pour créer un CATPart à partir de chaque corps de pièces de mon AllCATPart?
En bref, j'ai un CATPart composé de n corps de pièces que je souhaite transformer en :
un CATProduct avec n CATPart
merci d'avance,
JER
Dernière édition par jer75 le Jeu 30 Nov 2017 - 11:07, édité 1 fois
jer75- actif
- Messages : 21
Date d'inscription : 27/05/2015
Age : 46
Localisation : paris
Re: Convertir un CATPart en CATProduct
Bonjour JER,
Ci dessous une macro CARScript pour ta conversion:
Ci dessous une macro CARScript pour ta conversion:
- Code:
'------------------------------------------------------------
' original Makroname = KopyPARTtoPRODUCT.CATScript
' Makroname = PARTtoPRODUCT_R16_hybrid_4.CATScript
'
' Author: Filippo Gozza
' Version: V5R10, V5R12
'
' angepasst an V5R16 - Lusilnie@cad.de
' Erweiterung GeoSets - Lusilnie@cad.de
' PartBody tauschen - Lusilnie@cad.de
' Korrekturen - denyo_1@cad.de
' Korrekturen - Lusilnie@cad.de
'------------------------------------------------------------
' Konvertiert ein CATPart in ein CATProduct
' Alle Koerper werden in CATPart's konvertiert
' Erweiterung: Alle GeoSets werden auch in CATPart's kopiert
'------------------------------------------------------------
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
Dim PartNeu As product
Dim workPart As PartDocument
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
On Error Resume Next
Set PartNeu = ProductNeu.Products.AddNewComponent("Part", CStr(KoerperName))
If Err.Number <> 0 Then
On Error GoTo 0
l = ProductNeu.Products.Count
Set PartNeu = ProductNeu.Products.Item(l)
KoerperName = KoerperName & "." & I
PartNeu.PartNumber = KoerperName
ProductNeu.Products.Item(l).Name = KoerperName & ".1"
Else
On Error GoTo 0
End If
' 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
' Variante 1: Einfuegen "wie vorhanden"
'ProductNeu.Parent.selection.Paste
' Variante 2: Einfuegen als "toter Solid"
ProductNeu.Parent.selection.PasteSpecial "CATPrtResultWithOutLink"
ProductNeu.Parent.selection.Clear
'eingefuegten Koerper zum PartBody machen und Ex-PartBody loeschen
Set workPart = ProductNeu.Products.Item(PartNeu).ReferenceProduct.Parent
If workPart.Part.Bodies.Count > 1 Then
workPart.Part.MainBody = workPart.Part.Bodies.Item(workPart.Part.Bodies.Count)
ProductNeu.Parent.selection.Add workPart.Part.Bodies.Item(1)
ProductNeu.Parent.selection.Delete
ProductNeu.Parent.selection.Clear
End If
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
' Variante 1: Einfuegen "wie vorhanden"
'ProductNeu.Parent.selection.Paste
' Variante 2: Einfuegen als "totes Element"
ProductNeu.Parent.selection.PasteSpecial "CATPrtResultWithOutLink"
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
lumpazepfel- Fédérateur
- Messages : 319
Date d'inscription : 02/11/2015
Localisation : Ensisheim
Re: Convertir un CATPart en CATProduct
Merci @lumpazepfel, je vais tester.
[edit]
J'ai testé, c'est de la balle, merci !
JOIE!
sujet soldé
[edit]
J'ai testé, c'est de la balle, merci !
JOIE!
sujet soldé
jer75- actif
- Messages : 21
Date d'inscription : 27/05/2015
Age : 46
Localisation : paris
Re: Convertir un CATPart en CATProduct
Intéressant cette macro, je la garde sous le coude
J'ai souvent recréé des assemblages en exportant chaque corps en STEP ou pièces (et ce fût souvent très long...)
Merci pour le partage!
J'ai souvent recréé des assemblages en exportant chaque corps en STEP ou pièces (et ce fût souvent très long...)
Merci pour le partage!
d.vincent567- actif
- Messages : 84
Date d'inscription : 05/11/2016
Localisation : Brest
Sujets similaires
» CATPart et CATProduct
» Detecter le Niveau Actif (CATProduct/Composant/CATPart)
» Creation d'un fichier standard de type CATPart, CATProduct, CATDrawing
» Macro VBA - Enregistrer sous de tous les CATProduct et CATPart uniquement présents dans CATIA.ActiveDocument ?
» CONVERTIR UN FICHIER PRODUCT EN PART AVEC CATIA V5R17
» Detecter le Niveau Actif (CATProduct/Composant/CATPart)
» Creation d'un fichier standard de type CATPart, CATProduct, CATDrawing
» Macro VBA - Enregistrer sous de tous les CATProduct et CATPart uniquement présents dans CATIA.ActiveDocument ?
» CONVERTIR UN FICHIER PRODUCT EN PART AVEC CATIA V5R17
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum