how to add a hatch pattern in autocad database using vba code example
Example: how to add a hatch pattern in autocad database using vba
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