08-19-2024
11:03 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
08-19-2024
11:03 AM
@Maxim-CADman77 , here is what I had on hand. It is a version of what @Cadkunde.nl posted a while back.
It's been a bit since I looked at this, but I think I reworked it with the goal of returning the same result as if we used the Measure tool manually. I don't know how reliable the results are, but it seemed to work well for me when I was working with this in the past. MjDeck might have more straightforward approach though.
the original is here:
Sub main Dim oFace1 = ThisApplication.CommandManager.Pick _ (SelectionFilterEnum.kPartFacePlanarFilter, "Select first face") Dim oFace2 = ThisApplication.CommandManager.Pick _ (SelectionFilterEnum.kPartFacePlanarFilter, "Select second face") Dim oAngle As Double = ThisApplication.MeasureTools.GetAngle(oFace1, oFace2) * 180 / Math.PI Dim oComparisonPts1 As Object = GetComparisionPoints(oFace1) Dim oComparisonPts2 As Object = GetComparisionPoints(oFace2) Dim oDistance1 As Double = ThisApplication.MeasureTools.GetMinimumDistance _ (oComparisonPts1(0), oComparisonPts2(0)) Dim oDistance2 As Double = ThisApplication.MeasureTools.GetMinimumDistance _ (oComparisonPts1(1), oComparisonPts2(1)) Dim oLine As LineSegment = ThisApplication.TransientGeometry.CreateLineSegment _ (oComparisonPts1(0), oComparisonPts1(2)) Dim oIntersectpoint As ObjectsEnumerator = oLine.IntersectWithSurface(oFace2.Geometry) If oDistance1 > oDistance2 And Not oIntersectpoint Is Nothing Then oQ = "Quadrant 1" oAngle = oAngle ElseIf oDistance1 > oDistance2 And oIntersectpoint Is Nothing Then oQ = "Quadrant 2" oAngle = 180 - oAngle ElseIf oDistance1 < oDistance2 And Not oIntersectpoint Is Nothing Then oQ = "Quadrant 3" oAngle = 180 - oAngle ElseIf oDistance1 < oDistance2 And oIntersectpoint Is Nothing Then oQ = "Quadrant 4" oAngle = oAngle End If MsgBox(oAngle, , oQ) End Sub Function GetComparisionPoints(oFace As Face) Dim FacePoint1 As Point = oFace.PointOnFace Dim Params(1) As Double Params(0) = 0 Params(1) = 0 Dim Normals(2) As Double oFace.Evaluator.GetNormal(Params, Normals) Dim FacePoint2 As Point = ThisApplication.TransientGeometry.CreatePoint _ (FacePoint1.X + Normals(0) * 0.001, FacePoint1.Y + Normals(1) * 0.001, FacePoint1.Z + Normals(2) * 0.001) Dim FacePoint3 As Point = ThisApplication.TransientGeometry.CreatePoint _ (FacePoint1.X + Normals(0) * 9999, FacePoint1.Y + Normals(1) * 9999, FacePoint1.Z + Normals(2) * 9999) GetComparisionPoints = New Point() {FacePoint1, FacePoint2, FacePoint3 } End Function