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

Anonymous

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

Anonymous
Not applicable

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...

 

0 Likes
Reply
Accepted solutions (1)
2,514 Views
5 Replies
Replies (5)

Hallex
Advisor
Advisor
Accepted solution

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

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
0 Likes

Anonymous
Not applicable

This is very good... Thanks so much, Hallex, much appreciated.

0 Likes

Hallex
Advisor
Advisor

Glad to help

Happy vbneting,

Cheers 🙂

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
0 Likes

smx_khang
Contributor
Contributor

@Hallex 

Thanks for your sample. It is very helpful to me.
However, I have a question. Can you explain to me why you are using below API?

btr.SetObjectIdsInFlux()

 I can see that hatch is generated with or without that line... Can you tell me what is `SetObjectIdsInFlux` used for?

0 Likes

kdub_nz
Advisor
Advisor

@smx_khang 

 

perhaps :

https://help.autodesk.com/view/OARX/2022/ENU/?guid=OARX-ManagedRefGuide-Autodesk_AutoCAD_DatabaseSer...


// Called Kerry in my other life.

Everything will work just as you expect it to, unless your expectations are incorrect.
Sometimes the question is more important than the answer.

class keyThumper<T> : Lazy<T>;      another  Swamper

0 Likes