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
Solved! Go to Solution.
Solved by Alexander.Rivilis. Go to Solution.
Solved by Alexander.Rivilis. Go to Solution.
Are you setting oHatch.SetHatchPattern(...) before oHatch.PatternAngle = PatternAngle ?
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
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
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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 🙂
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.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
hi!
know it look like it will works!
thanks! or i call back again.
regards Jan
@jan_tappenbeck wrote:
...thanks! or i call back again...
In any case, please, inform me about results.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
No errors and exceptions?
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
Can't find what you're looking for? Ask the community or share your knowledge.