topic How to add a hatch pattern within rectangular boundaries in a block in .NET Forum

How to add a hatch pattern within rectangular boundaries in a block

Anonymous — Thu, 28 Feb 2013 17:55:50 GMT

Hi folks,

I am in the process of translating existing VBA code into its equivalent in VB.NET (developing VS Professional 2010 and testing in AutoCAD 2010)

My problem is that I have never done hatching in VB.NET before, and now I am required to hatch a rectangular area (defined by lines) within an AutoCAD block. I have absolutely no idea how to go about accomplishing this task.

To create my block, I am using a DBObjectCollection to store my lines, and then append them to the block definition, creating a reference to see what I just created.

If I were to define a rectangular outline within this block, how can I possibly hatch it?

Any pointers? Suggestions? Thanks in advance...

Re: How to add a hatch pattern within rectangular boundaries in a block

Hallex — Thu, 28 Feb 2013 20:28:51 GMT

Here is a code to crate hatch with lines

you have to select two opposite lines and create

polyline to bund the area then apply hatch

Public Sub HatchLines()

        Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

        Dim docloc As DocumentLock = doc.LockDocument()

        Dim ed As Editor = doc.Editor

        Dim db As Database = doc.Database

        Dim tr As Transaction = db.TransactionManager.StartTransaction()

        Using docloc

            Using tr

                'ed.StartUserInteraction(Me)'<-- just in case you using this code from form button

                Dim peo As PromptEntityOptions = New PromptEntityOptions(vbCr & "Select first line: ")

                peo.SetRejectMessage(vbCr & "Select line only: ")

                peo.AddAllowedClass(GetType(Line), True)

                Dim pres As PromptEntityResult = ed.GetEntity(peo)

                If (pres.Status <> PromptStatus.OK) Then

                    Return

                End If

                Dim ent As Entity = CType(tr.GetObject(pres.ObjectId, OpenMode.ForRead), Entity)

                Dim line1 As Line = DirectCast(ent, Line)

                If line1 Is Nothing Then

                    Return

                End If

                peo.Message = vbCr & "Select second line: "

                pres = ed.GetEntity(peo)

                If (pres.Status <> PromptStatus.OK) Then

                    Return

                End If

                ent = CType(tr.GetObject(pres.ObjectId, OpenMode.ForRead), Entity)

                Dim line2 As Line = DirectCast(ent, Line)

                If line2 Is Nothing Then

                    Return

                End If

                Dim sp1 As Point3d = line1.StartPoint

                Dim ep1 As Point3d = line1.EndPoint

                Dim sp2 As Point3d = line2.StartPoint

                Dim ep2 As Point3d = line2.EndPoint

                'check for line directions
                If Math.Abs(line1.Angle - line2.Angle) >= Math.PI Then
                    'swap points if the second line has an opposite direction
                    Dim tmp As Point3d = sp1

                    sp1 = ep1

                    ep1 = tmp

                End If

                Dim btr As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)

                Dim pl As Polyline = New Polyline()

                pl.AddVertexAt(0, New Point2d(sp1.X, sp1.Y), 0, 0, 0)

                pl.AddVertexAt(1, New Point2d(ep1.X, ep1.Y), 0, 0, 0)

                pl.AddVertexAt(2, New Point2d(ep2.X, ep2.Y), 0, 0, 0)

                pl.AddVertexAt(3, New Point2d(sp2.X, sp2.Y), 0, 0, 0)

                pl.Closed = True

                btr.AppendEntity(pl)

                tr.AddNewlyCreatedDBObject(pl, True)

                Dim ids As ObjectIdCollection = New ObjectIdCollection

                ids.Add(pl.ObjectId)

                db.TransactionManager.QueueForGraphicsFlush()

                Dim hatch As Hatch = New Hatch()

                hatch.HatchStyle = HatchStyle.Normal

                hatch.PatternScale = 60.0 '<--change hatch scale to suit

                hatch.PatternAngle = 0.0

                hatch.SetHatchPattern(HatchPatternType.PreDefined, "ANSI37") '<--change pattern name to suit

                hatch.AppendLoop(HatchLoopTypes.Outermost, ids)

                hatch.Associative = False

                hatch.EvaluateHatch(False)

                btr.SetObjectIdsInFlux()

                btr.AppendEntity(hatch)

                tr.AddNewlyCreatedDBObject(hatch, True)

                pl.Erase()

                pl.Dispose()

                ed.Regen()

                tr.Commit()

            End Using

        End Using

    End Sub

You then go expand this code to your needs