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...
Solved! Go to Solution.
Solved by Hallex. Go to 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
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?