Message 1 of 6
Create Geometry Intent for Drawing View on Spline min/max snap points - VBA

Not applicable
04-25-2019
04:15 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi to community.
For SPline curves PointIntentEnum definitions are not working ( I haven't find anything so far) for creating geometry intents relevant to snap points of min/max. On the figure below I need to find points like P1, P2 and P3 in order to create dimensions by code. Drawing Curves Geometry Intents
So I found some codes and adapt them to the purpose;
This is the part of vba sub for dividing Splines in to multiple geometric intents:
Sub AddGI(ByRef oGeometryIntents() As GeometryIntent, oGeometryIntent As GeometryIntent) ReDim Preserve oGeometryIntents(UBound(oGeometryIntents) + 1) Set oGeometryIntents(UBound(oGeometryIntents)) = oGeometryIntent End Sub
'Dim oGeometryIntents() As GeometryIntent 'Dim oGI As GeometryIntent 'ReDim oGeometryIntents(0 To 0) 'For Each oDrawingCurve In oDrawingView.DrawingCurves 'Select Case oDrawingCurve.CurveType Case CurveTypeEnum.kBSplineCurve: Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kEndPointIntent) AddGI oGeometryIntents, oGI Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kStartPointIntent) AddGI oGeometryIntents, oGI Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kMidPointIntent) AddGI oGeometryIntents, oGI Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kCenterPointIntent) AddGI oGeometryIntents, oGI '' DIVIDE SPLINES Dim MinParam As Double Dim MaxParam As Double Call oDrawingCurve.Evaluator2D.GetParamExtents(MinParam, MaxParam) Dim i As Long Dim dblParams(0 To 0) As Double Dim dblPointsCoord() As Double Dim dblCoordinates() As Double Dim NbrOfPoints As Long NbrOfPoints = 25 ReDim dblCoordinates(0 To NbrOfPoints, 1 To 2) For i = 0 To NbrOfPoints dblParams(0) = MinParam + i * (MaxParam - MinParam) / NbrOfPoints Call oDrawingCurve.Evaluator2D.GetPointAtParam(dblParams, dblPointsCoord) dblCoordinates(i, 1) = dblPointsCoord(0) dblCoordinates(i, 2) = dblPointsCoord(1) Dim oPointOnSPlineCurve As Point2d Set oPointOnSPlineCurve = ThisApplication.TransientGeometry.CreatePoint2d(dblPointsCoord(0), dblPointsCoord(1)) Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, oPointOnSPlineCurve) AddGI oGeometryIntents, oGI Next i '' END DIVIDE SPLINES ''They don't have any effect for spline curve ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kBottomRightPointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kBottomMiddlePointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kBottomLeftPointIntent) ' AddGI oGeometryIntents, oGI ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kLeftMiddlePointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kRightMiddlePointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kTopLeftPointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kTopMiddlePointIntent) ' AddGI oGeometryIntents, oGI ' ' Set oGI = oDrawingView.Parent.CreateGeometryIntent(oDrawingCurve, PointIntentEnum.kTopRightPointIntent) ' AddGI oGeometryIntents, oGI Case CurveTypeEnum.kUnknownCurve: MsgBox ("Unknown") 'reserved for later Case Else: End Select Next oDrawingCurve
SPLINE MIN/MAX approximation
'Draw Intent Points Dim oDrawingSketchPoints As DrawingSketch Set oDrawingSketchPoints = oDrawingView.Sketches.Add oDrawingSketchPoints.name = "Sketch Points" oDrawingSketchPoints.Edit 'Dim i As Integer For i = 1 To UBound(oGeometryIntents) Dim oSketchCircle As SketchCircle If Not oGeometryIntents(i).PointOnSheet Is Nothing Then Set oSketchCircle = oDrawingSketchPoints.SketchCircles.AddByCenterRadius(oDrawingSketchPoints.SheetToSketchSpace(oGeometryIntents(i).PointOnSheet), 0.1) oSketchCircle.LineWeight = 0.1 oSketchCircle.OverrideColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0) End If Next i oDrawingSketchPoints.ExitEdit
Is there any convenience way to find these min/max snap points of SPlines using VBA?
Thanks in advance.