Code:
Private Sub Test_KantenLaenge()
Dim ipt As PartDocument: Set ipt = ThisApplication.ActiveDocument
Dim cd As PartComponentDefinition: Set cd = ipt.ComponentDefinition
Dim b As SurfaceBody: Set b = cd.SurfaceBodies(1) Dim fA As Face: Set fA = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Erste Fläche wählen")
Dim fB As Face: Set fB = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Zweite Fläche wählen")
Dim fC As Face: Set fC = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Erste angrenzende Fläche wählen")
Dim fD As Face: Set fD = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Zweite angrenzende Fläche wählen")
Dim tG As TransientGeometry: Set tG = ThisApplication.TransientGeometry
Dim intLin As Line: Set intLin = tG.SurfaceSurfaceIntersection(fA.Geometry, fB.Geometry)(1)
Dim pA As Point: Set pA = tG.CurveSurfaceIntersection(intLin, fC.Geometry)(1)
Dim pB As Point: Set pB = tG.CurveSurfaceIntersection(intLin, fD.Geometry)(1)
Dim Lng As Double: Lng = pA.DistanceTo(pB) * 10
Call LinieZeichnenP(pA, pB, "test")
Call MsgBox("Länge: " & Lng & " mm")
End Sub