Create hybridShapePointCenter 1

[mayrou]

Hi!!!
I'm having some trouble getting update to work the way I'm expecting it to.

Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim product1 As Product
Set product1 = productDocument1.Product

Dim partDocument1 As Document
Set partDocument1 = documents1.Item("part.1")

Dim part1 As Part
Set part1 = partDocument1.Part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim shapeFactory1 As Factory
Set shapeFactory1 = part1.ShapeFactory

Dim body1 As Body
Set body1 = bodies1.Item("Corps principal")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes

Dim hybridShapes1 As HybridShapes
Set hybridShapes1 = body1.HybridShapes

MsgBox "selectionnez un trou"
Dim InputObjectType(0), Status1
InputObjectType(0)="Hole"
Status1=selection1.SelectElement2(InputObjectType,"Select un trou",false)
If Status1 = "Cancel" Then selection1.Clear: Exit Sub
nom_trou= oHole.Name

Dim partDocument2 As Document
Set partDocument2 = documents1.Item("part.2")

Dim part2 As Part
Set part2 = partDocument2.Part

Dim bodies2 As Bodies
Set bodies2 = part2.Bodies

Dim body2 As Body
Set body2 = bodies2.Item("Corps principal")

Dim sketches1 As Sketches
Set sketches1 = body2.Sketches

Dim shapes2 As Shapes
Set shapes2 = body2.Shapes

Dim hole2 As Shape
Set hole2 =shapes2.Item(nom_trou)

Dim sketch2 As Sketch
Set sketch2 = hole2.Sketch

Dim reference_piece As Reference
Set reference_piece= part2.CreateReferenceFromObject( hole2)
Set reference1 = Selection1.Item(1).value

Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapePointCenter1 As HybridShapePointCenter
Set hybridShapePointCenter1 = hybridShapeFactory1.AddNewPointCenter(reference_piece)

Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Set géométrique.1")

hybridBody1.AppendHybridShape hybridShapePointCenter1
part1.InWorkObject = hybridShapePointCenter1

part1.Update

so if anyone has a better understanding of the best way to use this method it would be appreciated,
th u ))

 

[itsmyjob]

Func AddNewPointCenter( Reference iCurve) As HybridShapePointCenter

Creates a new circle center point within the current body.

Parameters:

iCurve
Reference circle

Sub-element(s) supported (see

Boundary object): see Edge.
oPoint
Created point


in your code the reference is pointing to the Hole feature from selection. The reference for AddNewPointCenter is supposed to be a curve (or an edge).

Eric N.
indocti discant et ament meminisse periti ​

 

[mayrou]

thank you Eric!!
my macro selects a hole then recuperates its diameter! then creates a center point!!
but if l try to work with curve or edge! i can't get the diameter!!!
so, is there another solution?

 

[itsmyjob]

this should get hole and hole origin relative to its part, not the assembly.

 Dim InputObjectType(0), Status1, activedoc, selection

 Set activedoc = CATIA.ActiveDocument
 Set selection = activedoc.selection

 InputObjectType(0) = "Hole"
 Status = selection.SelectElement2(InputObjectType, "Select a Hole", True)
 If (Status = "cancel") Then Exit Sub
 
 Dim oHole 'As Hole // you cannot dim object if you want to use GetOrigin
  
 Set oHole = selection.Item(1).Value

Dim oHoleCenterXYZ(2) 'As Double // you cannot dim object if you want to use GetOrigin

oHole.GetOrigin oHoleCenterXYZ  ' objects are not dim but it works!

MsgBox ("Selected hole name = " & oHole.Name)
MsgBox ("Hole center x:" & oHoleCenterXYZ(0) & " y:" & oHoleCenterXYZ(1) & _
[indent][/indent]" z:" & oHoleCenterXYZ(2))

Eric N.
indocti discant et ament meminisse periti ​

 

[itsmyjob]

I was looking around the net and I would like here to bring a big thank you to GROZEA Ion for his usefull catia VBA function.

Look at this !

I will put all of it in FAQ... this is good!

Eric N.
indocti discant et ament meminisse periti ​

 

[ferdo]

Indeed, very good, I learned a lot from gvi70000 in catiav5forum.de forum.....

Regards
Fernando

https://picasaweb.google.com/102257836106335725208

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