Measure coordinates of a circular edge Catia VBA 1

[Jegsaran]

Hello everyone,
I am working in an assembly which contains numerous child products and parts. I am trying to measure the coordinate of a circular edge, all I am getting is based on the part's axis system. I need to get the global coordinate. Is there any idea to get it?

As far as I have the following code;

Sub CATMain()
Dim doc, sel, spa, ref, measurable
Dim inputObjectType(0)

Set doc = CATIA.ActiveDocument
Set sel = doc.Selection

'Selection of circular edge
inputObjectType(0) = "TriDimFeatEdge"
Status = sel.SelectElement2(inputObjectType, "Select the circular edge", True)
If (Status = "cancel") Then Exit Sub

Set ref = sel.Item(1).Reference
Set spa = doc.GetWorkbench("SPAWorkbench")
Set measurable = spa.GetMeasurable(ref)
sel.Clear

Dim aRel(2)
measurable.GetCenter aRel

MsgBox "x = " & aRel(0) & " ; y = " & aRel(1) & " ; z = " & aRel(2)
End Sub

 

[LWolf]

yupp, you need to do some rudimentary matrix operations... search the forum, it has been done before...

regards,
LWolf

 

[Jegsaran]

I searched fot it but I didn't get any in this forum. So pasting a link from COE forum.

http://www.coe.org/p/fo/et/thread=24828

http://www.coe.org/p/fo/et/thread=15155

http://www.coe.org/p/fo/et/thread=14697

 

[LWolf]

there you go...

regards,
LWolf

 

[Jegsaran]

All the above links doesn't gave me what I needed. So I creted a point on the center of the edge and got the coordinates using "GetMinimumDistancePoints"

 

[Little Cthulhu]

Post your full code, please.

 

[Jegsaran]

Public ActDoc As Document
Public Sel, Sel2 As Selection
Public Status As String
Public ref, RefoTempltPrtAxisSystem, RefSelPartCtrPt As Reference
Public SPA As Workbench
Public Measurable 'As Measurable
Public SelPart As Part
Public SelPartHybBodies, oTempltPrtHybBodies As HybridBodies
Public SelPartHybBody, oTempltPrtHybBody As HybridBody
Public SelPartHSFact As Factory
Public SelPartCtrPt As HybridShapePointCoord
Public oTopAssy, oTempltAssy As Product
Public opartDoc As PartDocument
Public oTempltPrt As Part
Public oTempltPrtAxisSystems As AxisSystems
Public oTempltPrtAxisSystem As AxisSystem
Public oTempltPrtHybShapePt As HybridShapePointCoord
Public oTempltPrtHybShapes As HybridShapes
Public oX, oY, oZ


Sub CATMain()

Dim inputObjectType(0)
Dim csCoords(2)
Dim Coordinates()

Set ActDoc = CATIA.ActiveDocument
Set Sel = ActDoc.Selection
Set Sel2 = ActDoc.Selection

inputObjectType(0) = "TriDimFeatEdge"
Status = Sel.SelectElement2(inputObjectType, "Select the edge", True) 'Selection of circular edge
If (Status = "cancel") Then Exit Sub
Set ref = Sel.Item(1).Reference
Set SPA = ActDoc.GetWorkbench("SPAWorkbench")
Set Measurable = SPA.GetMeasurable(ref)
Sel.Clear
Measurable.GetCenter csCoords
Set SelPart = ref.Parent.Parent.Parent.Parent.Parent
Set SelPartHybBodies = SelPart.HybridBodies
Set SelPartHybBody = SelPartHybBodies.Add()
Set SelPartHSFact = SelPart.HybridShapeFactory
Set SelPartCtrPt = SelPartHSFact.AddNewPointCoord(csCoords(0), csCoords(1), csCoords(2))
SelPartCtrPt.Compute
SelPartHybBody.AppendHybridShape SelPartCtrPt
SelPart.Update

Set oTopAssy = ActDoc.Product
Set oTempltPrt = oTopAssy.Part
Set oTempltPrtAxisSystems = oTempltPrt.AxisSystems
Set oTempltPrtAxisSystem = oTempltPrtAxisSystems.Item(1)
Set RefoTempltPrtAxisSystem = oTempltPrt.CreateReferenceFromObject(oTempltPrtAxisSystem)
Set RefSelPartCtrPt = SelPart.CreateReferenceFromObject(SelPartCtrPt)
'Set SPA = ActDoc.GetWorkbench("SPAWorkbench")
Set Measurable = SPA.GetMeasurable(RefoTempltPrtAxisSystem)
ReDim Coordinates(8)
Measurable.GetMinimumDistancePoints RefSelPartCtrPt, Coordinates

Dim GlobalCoords(2)
GlobalCoords(0) = Coordinates(3)
GlobalCoords(1) = Coordinates(4)
GlobalCoords(2) = Coordinates(5)

Set oTempltPrtHybBodies = oTempltPrt.HybridBodies
Set oTempltPrtHybBody = oTempltPrtHybBodies.Item("Points")
Set oTempltPrtHybShapes = oTempltPrtHybBody.HybridShapes
Set oTempltPrtHybShapePt = oTempltPrtHybShapes.Item("Front Point.1")
Set oX = oTempltPrtHybShapePt.x
oX.Value = GlobalCoords(0)
Set oY = oTempltPrtHybShapePt.y
oY.Value = GlobalCoords(1)
Set oZ = oTempltPrtHybShapePt.Z
oZ.Value = GlobalCoords(2)
oTempltPrt.Update
MsgBox "x = " & GlobalCoords(0) & " ; y = " & GlobalCoords(1) & " ; z = " & GlobalCoords(2)
'Dim parameters1 As Parameters 'Another method to update the coordinate
'Set parameters1 = part1.Parameters
'Dim length1 As Length
'Set length1 = parameters1.Item("FNA7578942_1\Points\Front Point.1\X")
'length1.Value = 5000#
'Set length2 = parameters1.Item("FNA7578942_1\Points\Front Point.1\Y")
'length2.Value = 5000#
'Set length3 = parameters1.Item("FNA7578942_1\Points\Front Point.1\Z")
'length3.Value = 5000#
End Sub

 

[Little Cthulhu]

Thanks.

Nice idea to use GetMinimumDistancePoints with axis system. Did you find it yourself?

 

[Jegsaran]

Yes. I was exploring with my friend in my office reg the manual options to find the global coordinates. As a result got this idea.