How to measure angle between two line using macro?

[Neerajjo]

How can i measure angle between lines using macro?

 

[Neerajjo]

Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)


hybridShapePointOnCurve1.DistanceType = 1


hybridBody1.AppendHybridShape hybridShapePointOnCurve1


part1.InWorkObject = hybridShapePointOnCurve1

' creating plane

Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)

hybridBody1.AppendHybridShape hybridShapePlaneNormal1

part1.InWorkObject = hybridShapePlaneNormal1

'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)

hybridShapeIntersection1.PointType = 0

hybridBody1.AppendHybridShape hybridShapeIntersection1

part1.InWorkObject = hybridShapeIntersection1

' selecting near curve

Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)

hybridBody1.AppendHybridShape hybridShapeNear1

part1.InWorkObject = hybridShapeNear1

' Making tangent curve on near curve



Dim reference21 As Reference
Set reference21 = part1.CreateReferenceFromObject(hybridShapeNear1)


Dim reference22 As Reference
Set reference22 = part1.CreateReferenceFromObject(hybridShapePointOnCurve1)



Dim reference23 As Reference
Set reference23 = part1.CreateReferenceFromObject(hybridShapePlaneNormal1)

Dim hybridShapeLineTangency1 As HybridShapeLineTangency
Set hybridShapeLineTangency1 = hybridShapeFactory1.AddNewLineTangencyOnSupport(reference21, reference22, reference23, 0#, 10#, False)

hybridBody1.AppendHybridShape hybridShapeLineTangency1





'creating line on giving direction

Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, direction, 0#, 5#, False)

Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")

hybridBody2.AppendHybridShape hybridShapeLinePtDir1

part1.InWorkObject = hybridShapeLinePtDir1


i tried using this code.....
'creating angle measure

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters

Dim angle1 As Angle
Set angle1 = parameters1.CreateDimension("", "ANGLE", 0#)

Dim relations1 As Relations
Set relations1 = part1.Relations

Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formula.6", "", angle1, "angle(`Geometrical Set.1\hybridShapeLineTangency1` ,`Geometrical Set.1\hybridBody2` ) ")

formula1.Rename "Formula.1"

 

[LWolf]

your second argument in the formula seems to be wrong. ?"`Geometrical Set.1\hybridBody2`"?

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument

Dim part1 As part
Set part1 = partDocument1.part

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
Dim angle1 As Angle
Set angle1 = parameters1.CreateDimension("", "ANGLE", 0)
Dim relations1 As Relations
Set relations1 = part1.Relations

Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formula.1", "", angle1, "angle(Final_Part\Line.1 ,Final_Part\Line.2 ) ")
formula1.Rename "Formula.1
part1.Update
End Sub

regards,
LWolf

 

[Neerajjo]

formula not taking link.

 

[LWolf]

did you replace

angle(Final_Part\Line.1 ,Final_Part\Line.2 ) "

with your geometry?

regards,
LWolf

 

[Neerajjo]

yes i did, formula is created but line link is not taken.

 

[Neerajjo]

this is my complete code.

Sub CATMain()

Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = part1.HybridBodies

Dim hybridBody1 As HybridBody
Set hybridBody1 = hybridBodies1.Item("Geometrical Set.1")

Dim varSelection As Variant
Set varSelection = partDocument1.Selection
Dim Sstatus

'selection of curve
ReDim sFilter(1)
MsgBox "Select Curve"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select curve", False)
Dim oCurve As Object
Set oCurve = varSelection.Item(1).Value
Dim reference2 As Reference
Set reference2 = part1.CreateReferenceFromObject(oCurve)
varSelection.Clear

'selecting surface
ReDim sFilter(1)
MsgBox "Select surface"
sFilter(0) = "HybridShape"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select surface", False)
Dim osurface As Object
Set osurface = varSelection.Item(1).Value
Dim surface As Reference
Set surface = part1.CreateReferenceFromObject(osurface)
varSelection.Clear

' Calculate curve length
Dim SpaWorkbench As SpaWorkbench
Dim theMeasurable As Measurable
Set SpaWorkbench = partDocument1.GetWorkbench("SPAWorkbench")
Set theMeasurable = SpaWorkbench.GetMeasurable(part1.CreateReferenceFromObject(oCurve))
part1.Update

'MsgBox CStr(theMeasurable.Length)
Dim b, C, D
b = theMeasurable.Length
MsgBox "Curve length" & b

'Enter no of section
C = CInt(InputBox("Enter Required number of section"))
D = b / C

'Selection of Point
ReDim sFilter(0)
MsgBox "Select Point"
sFilter(0) = "Point"
Sstatus = varSelection.SelectElement2(sFilter, "Select a point", False)
Dim opoint As Object
Set opoint = varSelection.Item(1).Value
Dim reference1 As Reference
Set reference1 = part1.CreateReferenceFromObject(opoint)
varSelection.Clear

'select press direction
ReDim sFilter(1)
MsgBox "Select cutting direction"
sFilter(0) = "HybridShapeCurveExplicit"
sFilter(1) = "MonoDim"
Sstatus = varSelection.SelectElement2(sFilter, "Select curve for direction", False)
Dim Pdirection As Object
Set Pdirection = varSelection.Item(1).Value

Dim reference5 As Reference
Set reference5 = part1.CreateReferenceFromObject(Pdirection)
Dim direction As HybridShapeDirection
Set direction = part1.HybridShapeFactory.AddNewDirection(reference5)

'Creating geometries using loop

Dim i As Integer
For i = 1 To C
Dim hybridShapeFactory1 As HybridShapeFactory
Set hybridShapeFactory1 = part1.HybridShapeFactory

Dim hybridShapePointOnCurve1 As HybridShapePointOnCurve
Set hybridShapePointOnCurve1 = hybridShapeFactory1.AddNewPointOnCurveWithReferenceFromDistance(reference2, reference1, D * i, False)


hybridShapePointOnCurve1.DistanceType = 1
hybridBody1.AppendHybridShape hybridShapePointOnCurve1
part1.InWorkObject = hybridShapePointOnCurve1

' creating plane
Dim hybridShapePlaneNormal1 As HybridShapePlaneNormal
Set hybridShapePlaneNormal1 = hybridShapeFactory1.AddNewPlaneNormal(reference2, hybridShapePointOnCurve1)

'Intersection curve
Dim hybridShapeIntersection1 As HybridShapeIntersection
Set hybridShapeIntersection1 = hybridShapeFactory1.AddNewIntersection(hybridShapePlaneNormal1, surface)
hybridShapeIntersection1.PointType = 0

Dim hybridShapeNear1 As HybridShapeNear
Set hybridShapeNear1 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)
hybridBody1.AppendHybridShape hybridShapeNear1
part1.UpdateObject hybridShapeNear1

' selecting near curve

Dim hybridShapeNear2 As HybridShapeNear
Set hybridShapeNear2 = hybridShapeFactory1.AddNewNear(hybridShapeIntersection1, hybridShapePointOnCurve1)

hybridBody1.AppendHybridShape hybridShapeNear2

part1.InWorkObject = hybridShapeNear2

' Making tangent curve on near curve

Dim reference21 As Reference
Set reference21 = part1.CreateReferenceFromObject(hybridShapeNear1)
Dim reference22 As Reference
Set reference22 = part1.CreateReferenceFromObject(hybridShapePointOnCurve1)
Dim reference23 As Reference
Set reference23 = part1.CreateReferenceFromObject(hybridShapePlaneNormal1)
Dim hybridShapeLineTangency1 As HybridShapeLineTangency
Set hybridShapeLineTangency1 = hybridShapeFactory1.AddNewLineTangencyOnSupport(reference21, reference22, reference23, 0#, 10#, False)
hybridBody1.AppendHybridShape hybridShapeLineTangency1


'creating line on giving direction

Dim hybridShapeLinePtDir1 As HybridShapeLinePtDir
Set hybridShapeLinePtDir1 = hybridShapeFactory1.AddNewLinePtDir(hybridShapePointOnCurve1, direction, 0#, 5#, False)
Dim hybridBody2 As HybridBody
Set hybridBody2 = hybridBodies1.Item("Geometrical Set.1")
hybridBody2.AppendHybridShape hybridShapeLinePtDir1
part1.InWorkObject = hybridShapeLinePtDir1

'creating angle measure

Dim parameters1 As Parameters
Set parameters1 = part1.Parameters
Dim angle1 As Angle
Set angle1 = parameters1.CreateDimension("", "ANGLE", 0#)
Dim relations1 As Relations
Set relations1 = part1.Relations
Dim formula1 As Formula
Set formula1 = relations1.CreateFormula("Formula.1", "", angle1, "angle(Final_Part\Line.1 ,Final_Part\Line.2 ) ")

formula1.Rename "Formula.1"





Next i


'part1.Update

End Sub

 

[weagan22]

Sub GetLinesAndMeasure()
    'Get the selection of the active part (user needs to pre-select 2 lines to measure)
    Dim uSel As Selection
    Set uSel = CATIA.ActiveDocument.Selection
    
    'Get the active part to be able to make references (what is shown will only work if the part is the open document)
    Dim ActivePart As Part
    Set ActivePart = CATIA.ActiveDocument.Part
    
    'Create a reference to the first selected line
    Dim Line1Ref As Reference
    Set Line1Ref = ActivePart.CreateReferenceFromObject(uSel.Item(1).Value)
    
    'Create a reference to the second selected line
    Dim Line2Ref As Reference
    Set Line2Ref = ActivePart.CreateReferenceFromObject(uSel.Item(2).Value)
    
    'Calculate and output the measured angle between the lines
    MsgBox "Angle between lines is: " & AngleMeasure(Line1Ref, Line2Ref) & "°", vbOKOnly, "Angle Measure"
End Sub


Function AngleMeasure(Line1Ref As Reference, Line2Ref As Reference) As Double
    
    'Get the "measurable" workbench
    Dim TheSPAWorkbench As Workbench
    Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench")
    
    'Create a measurable of the first line ref
    Dim TheMeasurable As Measurable
    Set TheMeasurable = TheSPAWorkbench.GetMeasurable(Line1Ref)
    
    'Measure the angle between the measurable and the second line
    Dim MeasuredAngle As Double
    MeasuredAngle = TheMeasurable.GetAngleBetween(Line2Ref)
    
    'Return the measured angle
    AngleMeasure = MeasuredAngle
End Function