Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
AutoCAD GripOverrule API sample, demonstrates how to add a direction grip that will change the direction of a polyline when clicked.
Option Explicit On
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.GraphicsInterface
Imports Autodesk.AutoCAD.DatabaseServices
Public Class DirectionGrip
Inherits GripData
Public Delegate Sub ComputeGripPosition()
Public Delegate Sub EntityAction(id As ObjectId)
Private ReadOnly _Crv As Curve
Private ReadOnly _GripAction As EntityAction
Private ReadOnly _AssignPosition As ComputeGripPosition
Private _GripDirection As Vector3d
Private _GripOffset As Double = 4.0#
Public Sub New(crv As Curve, gripAction As EntityAction)
If crv Is Nothing OrElse gripAction Is Nothing Then Throw New ArgumentNullException("Neither 'crv' or 'gripAction' arguments can be null.")
_Crv = crv
_AssignPosition = AddressOf AssignStartPosition
_GripAction = gripAction
End Sub
Public Sub New(crv As Curve, atStart As Boolean)
If crv Is Nothing Then Throw New ArgumentNullException("The 'crv' argument cannot be null.")
_Crv = crv
_GripAction = AddressOf ExecuteReverse
If atStart Then
_AssignPosition = AddressOf AssignStartPosition
Else
_AssignPosition = AddressOf AssignEndPosition
End If
_AssignPosition()
End Sub
Public Sub UpdateGripPoint()
_AssignPosition.Invoke()
End Sub
#Region "Overriden Methods"
Public Overrides Function OnHotGrip(entityId As ObjectId, contextFlags As Context) As ReturnValue
If contextFlags <> 0 Then Return ReturnValue.Failure
Try
_GripAction(_Crv.Id)
Return ReturnValue.GetNewGripPoints
Catch
Return ReturnValue.Failure
Finally
' A little hack to help ensure the entity and grips are regenerated.
Autodesk.AutoCAD.Internal.Utils.RegenEntity(_Crv.Id)
End Try
End Function
Public Overrides Function WorldDraw(wd As WorldDraw, entityId As ObjectId, type As DrawType, imageGripPoint As Point3d?, dGripSize As Double) As Boolean
Try : DrawDirection(wd, type, dGripSize)
Catch
End Try
Return True
End Function
#End Region
Private Sub DrawDirection(wd As WorldDraw, dt As DrawType, size As Double)
Dim a As Double = _GripDirection.GetAngleTo(Vector3d.XAxis)
If _GripDirection.Y < 0 Then a = Math.PI * 2 - a
Using pts As New Point3dCollection
Dim v As Vector3d = Me.GripPoint.GetAsVector() - New Vector3d(1.5# * size, 0#, 0#)
pts.Add(New Point3d(0, 0, 0) + v)
pts.Add(New Point3d(1.5 * size, 1.5 * size, 0) + v)
pts.Add(New Point3d(1.5 * size, 0.65 * size, 0) + v)
pts.Add(New Point3d(3 * size, 0.65 * size, 0) + v)
pts.Add(New Point3d(3 * size, -0.65 * size, 0) + v)
pts.Add(New Point3d(1.5 * size, -0.65 * size, 0) + v)
pts.Add(New Point3d(1.5 * size, -1.5 * size, 0) + v)
For index As Integer = 0 To pts.Count - 1
pts(index) = pts(index).RotateBy(a, Vector3d.ZAxis, Me.GripPoint)
Next
wd.SubEntityTraits.Color = If(dt = DrawType.WarmGrip, 82, 11)
wd.SubEntityTraits.FillType = FillType.FillAlways
wd.Geometry.Polygon(pts)
wd.SubEntityTraits.Color = If(dt = DrawType.WarmGrip, 3, 1)
wd.SubEntityTraits.FillType = FillType.FillNever
wd.Geometry.Polygon(pts)
End Using
End Sub
''' <summary>
''' Assign the grip position from the start of the curve.
''' </summary>
Private Sub AssignStartPosition()
Dim v As Vector3d = _Crv.GetFirstDerivative(_Crv.StartParam) * -1.0#
_GripDirection = v / v.Length
Me.GripPoint = _Crv.StartPoint + _GripDirection * _GripOffset
End Sub
''' <summary>
''' Assign the grip position from the end of the curve.
''' </summary>
Private Sub AssignEndPosition()
Dim v As Vector3d = _Crv.GetFirstDerivative(_Crv.EndParam)
v = v / v.Length
Me.GripPoint = _Crv.EndPoint + v * _GripOffset
_GripDirection = v * -1.0#
End Sub
''' <summary>
''' Reverse the direction of the curve.
''' </summary>
Private Shared Sub ExecuteReverse(id As ObjectId)
Dim dwg As Document = Application.DocumentManager.GetDocument(id.Database)
Using l = dwg.LockDocument(DocumentLockMode.ExclusiveWrite, "Reverse", "Reverse", False)
Using tr As Transaction = dwg.TransactionManager.StartTransaction()
Try
Dim crv As Curve = tr.GetObject(id, OpenMode.ForWrite, True, True)
crv.ReverseCurve()
Finally
tr.Commit()
End Try
End Using
End Using
End Sub
End Class
Option Explicit On
Imports System.ComponentModel
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Public Class SampleGrip
Inherits GripOverrule
Implements IRuleEnabled
Public Sub New()
MyBase.SetCustomFilter()
End Sub
#Region "IRuleEnabled Implements"
Public ReadOnly Property Name As String Implements IRuleEnabled.Name
Get
Return "Polyline Direction Grip"
End Get
End Property
Public Property Enabled As Boolean = False Implements IRuleEnabled.Enabled
#End Region
#Region "Overridden Methods"
Public Overrides Function IsApplicable(overruledSubject As RXObject) As Boolean
Return _Enabled AndAlso TypeOf overruledSubject Is Polyline AndAlso DirectCast(overruledSubject, Polyline).NumberOfVertices > 1
End Function
Public Overrides Sub GetGripPoints(entity As Entity, grips As GripDataCollection, curViewUnitSize As Double, gripSize As Integer, curViewDir As Vector3d, bitFlags As GetGripPointsFlags)
Try : ComputeGrips(entity, grips, curViewUnitSize, gripSize, curViewDir, bitFlags)
Catch
End Try
End Sub
#End Region
Private Sub ComputeGrips(entity As Entity, grips As GripDataCollection, curViewUnitSize As Double, gripSize As Integer, curViewDir As Vector3d, bitFlags As GetGripPointsFlags)
MyBase.GetGripPoints(entity, grips, curViewUnitSize, gripSize, curViewDir, bitFlags)
Dim crv As Curve = DirectCast(entity, Curve)
grips.Add(New DirectionGrip(entity, True))
If Not crv.Closed Then grips.Add(New DirectionGrip(entity, False))
End Sub
End Class
Public Interface IRuleEnabled
ReadOnly Property Name As String
Property Enabled As Boolean
End Interface
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment