How to add hatch to closed cuve in a DrawableOverrule ?

[Anonymous]

Hi Guys,

I've a problem with this piece of code.

My goal is to wirte a DrawableOverrule, wich would change the entities color to dark gray, except when they are on a specific layer. For closed-only curves in this layer, I want to add a semi-transparent hatch.

All works great, until user moves the mouse over this hatch : AutoCAD throws a fatal error and closes. I've no exception in debugger...

When I remove the code concerning the hatch, I've no error at all.

Any advice ?

Thanks

Public Class ClosedCurveDrawableOverrule
        Inherits DrawableOverrule

        Public Const HighlightColorIndex As Short = 1 'Color Red
        Public Const BaseColor As Short = 251 ' Color DarkGray
        Public Const SpecificLayer As String = "Layer1"

        ' Set our transparency to 50% (=127)
        ' Alpha value is Truncate(255 * (100-n)/100)   
        Public ReadOnly TransparencyColor = New Autodesk.AutoCAD.Colors.Transparency(CType(127, Byte))


#Region "Singleton Patern / ToggleOverrule"

        Private Sub New()
            boolIsEnabled = False
        End Sub

        Private Shared SharedInstance As ClosedCurveDrawableOverrule
        Public Shared Function GetInstance() As ClosedCurveDrawableOverrule
            If SharedInstance Is Nothing Then
                SharedInstance = New ClosedCurveDrawableOverrule
            End If
            Return SharedInstance
        End Function

        Private boolIsEnabled As Boolean = False
        Public Property IsEnabled As Boolean
            Get
                Return boolIsEnabled
            End Get
            Private Set(value As Boolean)
                boolIsEnabled = value
            End Set
        End Property

        Public Shared Sub ToggleOverrule()
            Dim this = ClosedCurveDrawableOverrule.GetInstance
            If this.IsEnabled = False Then
                Overrule.AddOverrule(RXObject.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Entity)), this, False)
                this.IsEnabled = True
            Else
                Overrule.RemoveOverrule(RXObject.GetClass(GetType(Autodesk.AutoCAD.DatabaseServices.Entity)), this)
                this.IsEnabled = False
            End If

        End Sub

#End Region

        Public Overrides Function WorldDraw(drawable As Autodesk.AutoCAD.GraphicsInterface.Drawable, wd As Autodesk.AutoCAD.GraphicsInterface.WorldDraw) As Boolean
            Dim entity As Entity = drawable

            If ClosedCurveDrawableOverrule.IsValidForHighlight(entity) = False Then
                wd.SubEntityTraits.Color = BaseColor
                MyBase.WorldDraw(drawable, wd)
                Return True
            Else
                wd.SubEntityTraits.Color = HighlightColorIndex

                If ClosedCurveDrawableOverrule.IsValidForHatch(entity) Then
                    wd.SubEntityTraits.Transparency = TransparencyColor
                    Using h As New Hatch()
                        h.SetDatabaseDefaults()
                        h.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")
                        h.ColorIndex = HighlightColorIndex
                        h.Layer = entity.Layer

                        Dim oic As New ObjectIdCollection
                        oic.Add(entity.ObjectId)
                        h.AppendLoop(HatchLoopTypes.Default, oic)

                        h.EvaluateHatch(True)
                        h.WorldDraw(wd)
                    End Using
                    wd.SubEntityTraits.Transparency = New Autodesk.AutoCAD.Colors.Transparency(CType(255, Byte))
                End If

                MyBase.WorldDraw(drawable, wd)
                Return True

            End If

        End Function

        Private Shared Function IsValidForHighlight(entity As Entity) As Boolean
            If entity.Layer = SpecificLayer Then Return True
            Return False
        End Function

        Private Shared Function IsValidForHatch(entity As Entity) As Boolean
            Dim curve = TryCast(entity, Curve)
            If curve Is Nothing Then Return False
            If curve.Closed = False Then Return False
            If curve.Database Is Nothing Then Return False
            Return True
        End Function

    End Class

[DiningPhilosopher]

Hatching is a highly-problematic entity in AutoCAD and I would not expect drawing and disposing them in a DrawableOverrule's WorldDraw to work. You can try keeping the Hatch object alive (store it in a list, and be sure to Dispose it at some point, probably when the next call to WorldDraw occurs for the same subject).

That may or may not work.

[Anonymous]

---

@DiningPhilosopher wrote:

Hatching is a highly-problematic entity in AutoCAD...

---

Exactly what I didn't want to hear !!

Ok, let's give it a try.

Here's the idea:

I keep a Dictionary(Of ObjectId, Hatch) linking the Curve.ObjectID and the hatch itself.

When WorldDraw is called, firstly I remove the hatch from my dictionary, calling then Hatch.Dispose. Once the hatch created, I add it to my dictionnary.

Would you wrote something-like ?

I've just tried, and it makes AutoCAD crash the same way...

[DiningPhilosopher]

I don't know if you can do what you're trying to do without also overruling things like osnap and object selection, because the Hatch is associated with the curve, and when AutoCAD is looking for something like osnap points when the cursor is over the hatch, you have to something usable.