create hatch - valid values for PatternAngle

[jan_tappenbeck]

hi !

i try to create hatch by vb.net and i define the value

oHatch.PatternAngle = PatternAngle

in my try PatternAngle=0.0 and i get the message:

Autodesk.AutoCAD.Runtime.Exception: eInvalidInput    bei Autodesk.AutoCAD.DatabaseServices.Hatch.set_PatternAngle(Double angle) 

the error-catch will work direct behind the code-line.

when i recommand the line it will be work.

could someone tell me the possible values?

reagards Jan

[Alexander.Rivilis]

Are you setting oHatch.SetHatchPattern(...) before oHatch.PatternAngle = PatternAngle  ?

[jan_tappenbeck]

hi !

no - here is the complet code:

...
Dim ObjIds As New ObjectIdCollection()
                        ObjIds.Add(pLineId)

                        Dim oHatch As New Hatch()
                        Dim normal As New Vector3d(0.0, 0.0, 1.0)
                        oHatch.Normal = normal
                        oHatch.Elevation = 0.0
                        oHatch.PatternScale = PatternScale
                        oHatch.PatternAngle = PatternAngle
                        oHatch.PatternAngle = 2.0

                        oHatch.SetHatchPattern(HatchPatternType.PreDefined, HatchPatternName)
                        oHatch.ColorIndex = HatchColor
                        acBlkTblRec.AppendEntity(oHatch)

                        acTrans.AddNewlyCreatedDBObject(oHatch, True)

                        oHatch.Associative = HatchAssociative

                        oHatch.AppendLoop(HatchLoopTypes.Default, ObjIds)
                        oHatch.EvaluateHatch(True)
...

regards Jan

[Alexander.Rivilis · Accepted solution]

Sorry, but you not given the full code, but some piece of code. 😞

Compare with this test code and see video:

Imports System
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput

<Assembly: CommandClass(GetType(Rivilis.TestHatch))> 
Namespace Rivilis
  Public Class TestHatch
    <CommandMethod("TestHatch")>
    Public Sub MyCommand()
      Dim doc As Document = Application.DocumentManager.MdiActiveDocument
      Dim ed As Editor = doc.Editor
      Dim per As PromptEntityResult = ed.GetEntity(vbCrLf + "Select closed polyline: ")
      If (per.Status <> PromptStatus.OK) Then
        Return
      End If
      Dim pLineId As ObjectId = per.ObjectId
      If Not pLineId.ObjectClass.IsDerivedFrom(RXClass.GetClass(GetType(Polyline))) Then
        ed.WriteMessage(vbCrLf + "It is not a Pilyline")
        Return
      End If

      Dim ObjIds As New ObjectIdCollection()
      ObjIds.Add(pLineId)

      Dim PatternScale As Double = 10
      Dim PatternAngle As Double = 2 ' In radians 
      Dim HatchPatternName As String = "LINE"
      Dim HatchColor As Integer = 1

      Dim tr As Transaction = doc.TransactionManager.StartTransaction

      Using (tr)
        Dim acBlkTblRec As BlockTableRecord = tr.GetObject(doc.Database.CurrentSpaceId, OpenMode.ForWrite)
        Dim oHatch As New Hatch()
        acBlkTblRec.AppendEntity(oHatch)
        tr.AddNewlyCreatedDBObject(oHatch, True)
        Dim normal As Vector3d = Vector3d.ZAxis
        oHatch.SetHatchPattern(HatchPatternType.PreDefined, HatchPatternName)
        oHatch.Normal = normal
        oHatch.Elevation = 0.0
        oHatch.PatternScale = PatternScale
        oHatch.PatternAngle = PatternAngle
        oHatch.ColorIndex = HatchColor
        oHatch.Associative = True

        oHatch.AppendLoop(HatchLoopTypes.Default, ObjIds)
        oHatch.EvaluateHatch(True)

        tr.Commit()
      End Using

    End Sub

  End Class

End Namespace

[jan_tappenbeck]

hi !

thanks for this very great example - but my problem is to recode this in my source.

here my whole code:

 ''' <summary>
    ''' Zeichnen einer Polylinie nach den Definitionen eines LineString mit der Option auch eine Flächenfüllung zu erzeugen
    ''' </summary>
    ''' <param name="PolyFID">FID der Polylinie</param>
    ''' <param name="LineScale">optional Objektlinienfaktor (default: 1)</param>
    ''' <param name="RealDimension">optional maßstäbliche Darstellung der Rohrbreite (default: false)</param>
    ''' <param name="LineWidth">optional Linienbreite (default: 0)</param>
    ''' <param name="HatchColor">optional AcadIndexFarbe (default: 256 ... vonLayer)</param>
    ''' <param name="HatchPatternName">optional Schraffurmustername (default: Solid)</param>
    ''' <param name="HatchAssociative">optional Assoziativität (default: true)</param>
    ''' <param name="PatternScale">optional SchraffurMaszstab (default: 1.0)</param>
    ''' <param name="PatternAngle">optional SchraffurAusrichtungswinkel im ARC (default: 0.0)</param>
    ''' <returns>Status 0 ... OK / 1 ... Fehler / 2... Polylinie mit einem Punkt</returns>
    Public Function DrawTBLineStringHatch_Work(ByVal PolyFID As Long, _
                                     ByVal TbDoc As Autodesk.Map.IM.Forms.Document, _
                                     Optional LineScale As Double = 1.0, _
                                     Optional RealDimension As Boolean = False, _
                                     Optional LineWidth As Double = 0.0, _
                                     Optional HatchColor As Integer = 256, _
                                     Optional HatchPatternName As String = "SOLID", _
                                     Optional HatchAssociative As Boolean = True, _
                                                                         Optional PatternScale As Double = 1.0, _
                                                                         Optional PatternAngle As Double = 0.0) As Integer

        Dim GeoCal As New EBL.MapService.Geometrie()
        Dim MapData As New EBL.MapService.MapData(TbDoc)
        Dim Delimeter As Integer = 0

        Dim LineStringPoint As Autodesk.Map.IM.Graphic.LinePoint = Nothing
        Dim LineStringPointStart As Autodesk.Map.IM.Graphic.LinePoint = Nothing

        Dim LinesStringFeature As Autodesk.Map.IM.Data.Feature
        Dim LinesStringTabelle As Autodesk.Map.IM.Data.FeatureClass

        ' Fehlerabfragen
        If HatchColor < 1 Or HatchColor > 256 Then HatchColor = 256
        If LineWidth < 0 Then LineWidth = 0
        If HatchPatternName.Length = 0 Then HatchPatternName = "SOLID"
        If PatternScale < 0 Then PatternScale = 1

        If RealDimension = True Then
            Delimeter = CInt(MapData.GetFeatureAttribut(PolyFID, "DIMENSION_2", "0", MapService.MapData.Genauigkeit.Meter))
            LineWidth = Delimeter / 1000
        End If

        LinesStringTabelle = TbDoc.Connection.FeatureClasses.GetFeatureClassWithFID(PolyFID)
        LinesStringFeature = LinesStringTabelle.GetFeature(PolyFID)

        Dim LineStringGeom As Autodesk.Map.IM.Graphic.Geometry
        Dim LineStringLine As Autodesk.Map.IM.Graphic.LineString

        LineStringGeom = LinesStringFeature.Geometry
        LineStringLine = CType(LineStringGeom, Autodesk.Map.IM.Graphic.LineString)

        If LineStringLine.Count = 1 Then
            Return 2
        End If

        LineStringPointStart = LineStringLine.Item(0)

        '' Get the current document and database
        Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim ErrDetail As String = ""

        Try
            ErrDetail = "Start a transaction"
            Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

                ErrDetail = "Open the Block table for read"
                Dim acBlkTbl As BlockTable

                ErrDetail = "lock document"
                Using acDoc.LockDocument

                    acBlkTbl = CType(acTrans.GetObject(acCurDb.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockTable)

                    ErrDetail = "Open the Block table record Model space for write"
                    Dim acBlkTblRec As BlockTableRecord

                    acBlkTblRec = CType(acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), BlockTableRecord)

                    ErrDetail = "Create a PolyLine"
                    Using acPoly As Polyline = New Polyline()
                        acPoly.LinetypeScale = LineScale
                        acPoly.ConstantWidth = LineWidth

                        For i As Integer = 0 To LineStringLine.Count - 1
                            LineStringPoint = LineStringLine.Item(i)

                            ' handelt es sich um eine geschlossene Polylinie ?
                            If i = LineStringLine.Count - 1 Then
                                ' Endpunkt = Startpunkt
                                If GeoCal.GeomCalculation(LineStringPoint.X, LineStringPoint.Y, LineStringPointStart.X, LineStringPointStart.Y, MapService.Geometrie.WhatToCalculate.Länge2D) <= 0.001 Then
                                    ' geschlossene Polylinie
                                    acPoly.Closed = vbYes
                                Else
                                    ' offene Polylinie
                                    acPoly.AddVertexAt(0, New Point2d(LineStringPoint.X, LineStringPoint.Y), 0, 0, 0)

                                End If
                            Else
                                'normaler Stützpunkt
                                acPoly.AddVertexAt(0, New Point2d(LineStringPoint.X, LineStringPoint.Y), 0, 0, 0)

                            End If
                        Next i

                        Dim pLineId As ObjectId
                        pLineId = acBlkTblRec.AppendEntity(acPoly)
                        acTrans.AddNewlyCreatedDBObject(acPoly, True)

                        ' ------------------------------- erstellen einer Schraffur -------------------

                        ErrDetail = "Create Hatch-Object"

                        Dim ObjIds As New ObjectIdCollection()
                        ObjIds.Add(pLineId)

                        Dim oHatch As New Hatch()
                        Dim normal As Vector3d = Vector3d.ZAxis
                        ErrDetail = "Create Hatch-Object - Set HatchPatterName"
                        oHatch.SetHatchPattern(HatchPatternType.PreDefined, HatchPatternName)
                        oHatch.Normal = normal
                        oHatch.Elevation = 0.0
                        ErrDetail = "Create Hatch-Object - Set PatternScale"
                        oHatch.PatternScale = PatternScale
                        ErrDetail = "Create Hatch-Object - Set PatternAngle"
                        'oHatch.PatternAngle = PatternAngle
                        oHatch.PatternAngle = 2.0
                        ErrDetail = "Create Hatch-Object - Set HatchColor"
                        oHatch.ColorIndex = HatchColor
                        ErrDetail = "Create Hatch-Object - Set Associative"
                        oHatch.Associative = HatchAssociative
                        ErrDetail = "Create Hatch-Object - Append Loop"
                        oHatch.AppendLoop(HatchLoopTypes.Default, ObjIds)

                        ErrDetail = "Create Hatch-Object - Create"
                        acBlkTblRec.AppendEntity(oHatch)

                        acTrans.AddNewlyCreatedDBObject(oHatch, True)


                        oHatch.EvaluateHatch(True)

                    End Using 'Polyline


                End Using 'acDoc.LockDocument
                ErrDetail = "Save the changes and dispose of the transaction"
                acTrans.Commit()
            End Using 'acTrans

        Catch ex As Exception
            _TryReport.Show("unerwarteter Fehler in EBL.MapService > cls_Acad > DrawTBLineStringHatch_Work", "ErrDetail: " & ErrDetail & vbCrLf & vbCrLf & _
                            "PolyFID: " & PolyFID.ToString & vbCrLf & _
        "LineWidth: " & LineWidth.ToString & vbCrLf & _
                                "HatchColor: " & HatchColor.ToString & vbCrLf & _
        "HatchPatternName: " & HatchPatternName & vbCrLf & _
        "HatchAssociative: " & HatchAssociative.ToString & vbCrLf & _
        "PatternScale: " & PatternScale.ToString & vbCrLf & _
        "PatternAngle: " & PatternAngle.ToString & vbCrLf & ex.ToString
        )

            Return 1
        End Try


        Return 0
    End Function

In this current version the error-function will start in the line

dim HatchAssociative as boolean = true
....
oHatch.Associative = HatchAssociative

could you look again ?

the source to create the border-polyline will work!!

regards Jan 🙂

[Alexander.Rivilis · Accepted solution]

Maybe you compare my code with your?

In my code:

Dim oHatch As New Hatch()
acBlkTblRec.AppendEntity(oHatch)
tr.AddNewlyCreatedDBObject(oHatch, True)
' After then I set other oHatch properties

In your code you:

Dim oHatch As New Hatch()
' Here you set other oHatch properties
acBlkTblRec.AppendEntity(oHatch)
acTrans.AddNewlyCreatedDBObject(oHatch, True)

There is different order of settings.

Also I recommend to split transaction on two parts:

1. First transaction have to create Polyline.

2. Second transaction have to create Hatch used ObjectId of created Polyline in first transaction.

[jan_tappenbeck]

hi!

know it look like it will works!

thanks! or i call back again.

regards Jan

[Alexander.Rivilis]

---

@jan_tappenbeck wrote:

...thanks! or i call back again...

---

In any case, please, inform me about results.

[jan_tappenbeck]

hi !

the current version will be ...

regards Jan

    Public Function DrawTBLineStringHatch_Work(ByVal PolyFID As Long, _
                                     ByVal TbDoc As Autodesk.Map.IM.Forms.Document, _
                                     ByVal CreateHatch As Boolean, _
                                     Optional LineScale As Double = 1.0, _
                                     Optional RealDimension As Boolean = False, _
                                     Optional LineWidth As Double = 0.0, _
                                     Optional HatchColor As Integer = 256, _
                                     Optional HatchPatternName As String = "SOLID", _
                                     Optional HatchAssociative As Boolean = True, _
                                                                         Optional PatternScale As Double = 1.0, _
                                                                         Optional PatternAngle As Double = 0.0) As Integer

        Dim GeoCal As New EBL.MapService.Geometrie()
        Dim MapData As New EBL.MapService.MapData(TbDoc)
        Dim Delimeter As Integer = 0

        Dim LineStringPoint As Autodesk.Map.IM.Graphic.LinePoint = Nothing
        Dim LineStringPointStart As Autodesk.Map.IM.Graphic.LinePoint = Nothing

        Dim LinesStringFeature As Autodesk.Map.IM.Data.Feature
        Dim LinesStringTabelle As Autodesk.Map.IM.Data.FeatureClass

        ' Fehlerabfragen
        If HatchColor < 1 Or HatchColor > 256 Then HatchColor = 256
        If LineWidth < 0 Then LineWidth = 0
        If HatchPatternName.Length = 0 Then HatchPatternName = "SOLID"
        If PatternScale < 0 Then PatternScale = 1

        If RealDimension = True Then
            Delimeter = CInt(MapData.GetFeatureAttribut(PolyFID, "DIMENSION_2", "0", MapService.MapData.Genauigkeit.Meter))
            LineWidth = Delimeter / 1000
        End If

        LinesStringTabelle = TbDoc.Connection.FeatureClasses.GetFeatureClassWithFID(PolyFID)
        LinesStringFeature = LinesStringTabelle.GetFeature(PolyFID)

        Dim LineStringGeom As Autodesk.Map.IM.Graphic.Geometry
        Dim LineStringLine As Autodesk.Map.IM.Graphic.LineString

        LineStringGeom = LinesStringFeature.Geometry
        LineStringLine = CType(LineStringGeom, Autodesk.Map.IM.Graphic.LineString)

        If LineStringLine.Count = 1 Then
            Return 2
        End If

        LineStringPointStart = LineStringLine.Item(0)

        '' Get the current document and database
        Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim ErrDetail As String = ""

        Try
            ErrDetail = "Start a transaction"
            Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

                ErrDetail = "Open the Block table for read"
                Dim acBlkTbl As BlockTable

                ErrDetail = "lock document"
                Using acDoc.LockDocument

                    acBlkTbl = CType(acTrans.GetObject(acCurDb.BlockTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), BlockTable)

                    ErrDetail = "Open the Block table record Model space for write"
                    Dim acBlkTblRec As BlockTableRecord

                    acBlkTblRec = CType(acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite), BlockTableRecord)

                    ErrDetail = "Create a PolyLine"
                    Using acPoly As Polyline = New Polyline()
                        acPoly.LinetypeScale = LineScale
                        acPoly.ConstantWidth = LineWidth

                        For i As Integer = 0 To LineStringLine.Count - 1
                            LineStringPoint = LineStringLine.Item(i)

                            ' handelt es sich um eine geschlossene Polylinie ?
                            If i = LineStringLine.Count - 1 Then
                                ' Endpunkt = Startpunkt
                                If GeoCal.GeomCalculation(LineStringPoint.X, LineStringPoint.Y, LineStringPointStart.X, LineStringPointStart.Y, MapService.Geometrie.WhatToCalculate.Länge2D) <= 0.001 Then
                                    ' geschlossene Polylinie
                                    acPoly.Closed = vbYes
                                Else
                                    ' offene Polylinie
                                    acPoly.AddVertexAt(0, New Point2d(LineStringPoint.X, LineStringPoint.Y), 0, 0, 0)

                                End If
                            Else
                                'normaler Stützpunkt
                                acPoly.AddVertexAt(0, New Point2d(LineStringPoint.X, LineStringPoint.Y), 0, 0, 0)

                            End If
                        Next i

                        Dim pLineId As ObjectId
                        pLineId = acBlkTblRec.AppendEntity(acPoly)
                        acTrans.AddNewlyCreatedDBObject(acPoly, True)

                        ' ------------------------------- erstellen einer Schraffur -------------------

                        If CreateHatch = True Then
                            ErrDetail = "Create Hatch-Object"

                            Dim ObjIds As New ObjectIdCollection()
                            ObjIds.Add(pLineId)

                            Dim oHatch As New Hatch()
                            acBlkTblRec.AppendEntity(oHatch)
                            acTrans.AddNewlyCreatedDBObject(oHatch, True)

                            Dim normal As Vector3d = Vector3d.ZAxis
                            ErrDetail = "Create Hatch-Object - Set HatchPatterName"
                            oHatch.SetHatchPattern(HatchPatternType.PreDefined, HatchPatternName)
                            oHatch.Normal = normal
                            oHatch.Elevation = 0.0
                            ErrDetail = "Create Hatch-Object - Set PatternScale"
                            oHatch.PatternScale = PatternScale
                            ErrDetail = "Create Hatch-Object - Set PatternAngle"
                            'oHatch.PatternAngle = PatternAngle
                            oHatch.PatternAngle = 2.0
                            ErrDetail = "Create Hatch-Object - Set HatchColor"
                            oHatch.ColorIndex = HatchColor
                            ErrDetail = "Create Hatch-Object - Set Associative"
                            oHatch.Associative = HatchAssociative
                            ErrDetail = "Create Hatch-Object - Append Loop"
                            oHatch.AppendLoop(HatchLoopTypes.Default, ObjIds)

                            'ErrDetail = "Create Hatch-Object - Create"
                            'acBlkTblRec.AppendEntity(oHatch)

                            'acTrans.AddNewlyCreatedDBObject(oHatch, True)
                            oHatch.EvaluateHatch(True)

                        End If ' CreateHatch

                    End Using 'Polyline


                End Using 'acDoc.LockDocument
                ErrDetail = "Save the changes and dispose of the transaction"
                acTrans.Commit()
            End Using 'acTrans

        Catch ex As Exception
            _TryReport.Show("unerwarteter Fehler in EBL.MapService > cls_Acad > DrawTBLineStringHatch_Work", "ErrDetail: " & ErrDetail & vbCrLf & vbCrLf & _
                            "PolyFID: " & PolyFID.ToString & vbCrLf & _
        "LineWidth: " & LineWidth.ToString & vbCrLf & _
                                "HatchColor: " & HatchColor.ToString & vbCrLf & _
        "HatchPatternName: " & HatchPatternName & vbCrLf & _
        "HatchAssociative: " & HatchAssociative.ToString & vbCrLf & _
        "PatternScale: " & PatternScale.ToString & vbCrLf & _
        "PatternAngle: " & PatternAngle.ToString & vbCrLf & ex.ToString
        )

            Return 1
        End Try


        Return 0
    End Function

[Alexander.Rivilis]

No errors and exceptions?