.NET
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

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

5 REPLIES 5
SOLVED
Reply
Message 1 of 6
mindofcat
2151 Views, 5 Replies

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

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

 

5 REPLIES 5
Message 2 of 6
Hallex
in reply to: mindofcat

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
Message 3 of 6
mindofcat
in reply to: Hallex

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

Message 4 of 6
Hallex
in reply to: mindofcat

Glad to help

Happy vbneting,

Cheers 🙂

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Message 5 of 6
smx_khang
in reply to: Hallex

@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?

Message 6 of 6
kdub_nz
in reply to: mindofcat

@smx_khang 

 

perhaps :

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

//

Everything will work just as you expect it to, unless your expectations are incorrect.

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

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk DevCon in Munich May 28-29th


Autodesk Design & Make Report

”Boost