.NET

Reply
Valued Contributor
mindofcat
Posts: 55
Registered: ‎05-14-2012
Message 1 of 4 (758 Views)
Accepted Solution

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

758 Views, 3 Replies
02-28-2013 09:55 AM

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

 

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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 4 (743 Views)

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

02-28-2013 12:28 PM 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
Valued Contributor
mindofcat
Posts: 55
Registered: ‎05-14-2012
Message 3 of 4 (738 Views)

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

02-28-2013 12:32 PM in reply to: Hallex

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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 4 of 4 (730 Views)

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

02-28-2013 12:59 PM in reply to: mindofcat

Glad to help

Happy vbneting,

Cheers :smileyhappy:

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.