[CATIA VBA] Symétrie de Final_Hole

[CATIADEV]

Bonjour à tous et meilleurs vœux pour cette nouvelle année !

 

Voilà, j'ai un souci à régler mais je n'arrive pas à m'en sortir.

:casstet:

Je réalise un outil qui fait automatiquement une pièce symétrique à partir d'un fichier CATPart existant.

Soit toto200.CATPArt la pièce et toto201.CATPArt la symétrie de cette pièce.

 

Pour vous donner une idée de l'outil, vous pouvez visiter ce lien :

http:// http://patrick.dubernet.free.fr/Files/CATIA/

Des vidéos expliquent l'outil.

 

Mon problème est que je n'arrive pas à obtenir l'outil Mirror Hole an CATVBA :mad:

 

http://patrick.dubernet.free.fr/Files/CATIA/Toolbar.jpg

 

 Public Function fCPHoles(strOpenName As String, strFile201 As String)
'-------------------------------------
'
'From 200 / copy / paste to 201
'
'-------------------------------------
Dim srcDoc As PartDocument
Set srcDoc = CATIA.Documents.Item(strOpenName)
Dim srcPart As Part
Set srcPart = srcDoc.Part
'***************************************************************
Dim targetDoc As PartDocument
Set targetDoc = CATIA.Documents.Item(strFile201 & ".CATPart")
Dim targetPart As Part
Set targetPart = targetDoc.Part
'***************************************************************
Dim oSel As Selection
Dim bodies1 As Bodies
Dim body1 As Body
Dim hybridBodies1 As HybridBodies
Dim hybridBody1 As HybridBody

'Set ListeBody = srcDoc.Selection
'ListeBody.Clear
'ListeBody.Search "(Part Design.Body),all"
'ListeBody.Clear
'Dim BoxProduct
'BoxProduct = MsgBox("Quantity of the bodies found:" & srcDoc.Part.Bodies.Count & "", 64)

Dim i As Integer

For i = 1 To srcDoc.Part.Bodies.Count
Set bodies1 = srcPart.Bodies
'Set body1 = srcPart.Bodies.Item(srcDoc.Part.InWorkObject.Name)
Set body1 = srcPart.Bodies.Item(i)

Dim strNameBody As String
strNameBody = srcDoc.Part.InWorkObject.Name

Dim partBody As Body
Set partBody = srcDoc.Part.Bodies.Item(strNameBody)
Dim intHoleType As Integer
intHoleType = srcDoc.Part.Bodies.Item(strNameBody).HybridBodies.Count

Dim j As Integer
For j = 1 To intHoleType

Set hybridBodies1 = srcDoc.Part.Bodies.Item(strNameBody).HybridBodies
Set hybridBody1 = hybridBodies1.Item(j)
Set oSel = srcDoc.Selection
oSel.Add hybridBody1
oSel.Copy

Set oSel = targetDoc.Selection

oSel.Clear
oSel.Add targetPart.Bodies.Item(strNameBody)
oSel.Paste

Dim strHoleType As String
strHoleType = targetDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name
targetDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name = Replace(strHoleType, strHoleType, srcDoc.Part.Bodies.Item(strNameBody).HybridBodies.Item(j).Name)

Dim strBodyN As String
strBodyN = targetDoc.Part.Bodies.Item(i).Name
oSel.Clear

Dim intElementHole As Integer
intElementHole = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Count

Dim e As Integer

For e = 1 To intElementHole

oSel.Add targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e)

Dim strHoleName As String
strHoleName = oSel.Name
'Set body2 = targetPart.Bodies.Item(i)
'Set partBody = targetPart.Bodies.Item(i)
'Set oSel = targetPart.Bodies.Item(i)

'        If frmSym201.ckbTexte = True Then 'ckbTexte = ResultOf ...
'
'        Else
'            body2.Name = Replace(body2.Name, "Result of ", "")
'        End If

' A finaliser ne fonctionne pas !!!!!!!!!!!!!!! -------------
'Dim shapeFactory1 As HybridShape 'ShapeFactory
'Set shapeFactory1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e) 'HybridShapeFactory
Dim hybridshape1 As HybridShape 'HybridShape 'ShapeFactory
Set hybridshape1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j)    '.HybridShapes.Item(e)



Dim symAxisSystem1 As AxisSystems
Set symAxisSystem1 = targetPart.AxisSystems

Dim symRefAxisSystem1 As AxisSystem
Set symRefAxisSystem1 = symAxisSystem1.Item("Absolute Axis System")

Dim reference1 As Reference
Set reference1 = targetPart.CreateReferenceFromBRepName _
   ("RSur:(Face:(Brp:(AxisSystem.1;3);None:();Cf9:());WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR14)", _
   symRefAxisSystem1)

'Mise en place de l'objet pour la symétrie ------------------------ error !
Dim symmetry1 As HybridShapeFactory
Set symmetry1 = hybridshape1   '.AddNewMirror(reference1)

'Dim hybridshape1 As HybridShape
'Set hybridshape1 = targetPart.Bodies.Item(strNameBody).HybridBodies.Item(j).HybridShapes.Item(e)

Set shapes1 = targetPart.Bodies.Item(j).HybridShapes    'HybridShapeFactory

Dim strSymNbre As String
strSymNbre = "Symmetry." & i + 100
Dim hybridShapeSymmetry1 As HybridShapeSymmetry
Set hybridShapeSymmetry1 = shapes1 'hybridshape1

targetPart.InWorkObject = hybridShapeSymmetry1
targetPart.Update

Set oSel = srcDoc.Selection
oSel.Clear
Next
Next
Next
End Function

 

Pouvez-vous m'aider à comprendre comment arriver à cet outil?

Je n'arrive pas à l'atteindre ni depuis le partbody, ni depuis le geometricalset ni avec le ShapeFactory ...

 

Bien à vous.

Cordialement,

Paloma

 

 

[Edité le 10/1/2007 par CATIADEV]