AppendLoop Error

[Anonymous]

I'm trying to create a hatch programmatically with the following code:

Public Sub SampleHatch()

Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor

Try

Dim Opts As New PromptSelectionOptions()

Dim filList() As TypedValue = {New TypedValue(DxfCode.Start, "LWPOLYLINE"), New TypedValue(DxfCode.LayerName, "0")}

Dim filter As SelectionFilter = New SelectionFilter(filList)
Dim res As PromptSelectionResult = ed.GetSelection(Opts, Filter)

If Not res.Status = PromptStatus.OK Then Return

Dim SS As Autodesk.AutoCAD.EditorInput.SelectionSet = res.Value

Dim idArray As ObjectId() = SS.GetObjectIds()

ed.WriteMessage("Selected --> " & SS.Count)

'
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim trans As Transaction = db.TransactionManager.StartTransaction() 'Start the transaction.
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim hatch As Hatch = New Autodesk.AutoCAD.DatabaseServices.Hatch

hatch.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")
hatch.ColorIndex = 4

btr.AppendEntity(hatch)
trans.AddNewlyCreatedDBObject(hatch, True)
hatch.Associative = True


Dim objcol As ObjectIdCollection = New Autodesk.AutoCAD.DatabaseServices.ObjectIdCollection
Dim employeeId As ObjectId
For Each employeeId In idArray

objcol.Add(employeeId)

Next

hatch.AppendLoop(HatchLoopTypes.Default, objcol)

hatch.EvaluateHatch(False)

trans.Commit()

Catch ex As System.Exception
MsgBox(ex.Message)
End Try

End Sub

I have two polyline, one within the other and i want to create a hatch that he excludes that inner one.

If i select only one polyline, it's OK.
If i select all (two), i have error in AppendLoop
The errror is eInvalidInput !

How i can create one hatch with two polyline ?

Thanks in advance.

[pavlos.katsonis]

I've not tried it but I think that a loop is just that: a single loop (closed polygon or closed polygon with arcs). You're trying to create a loop that has 2 such polygons (2 polylines). Try adding two separate loops to the hatch (two separate calls to the AppendLoop method). You may have to play a bit with HatchLoopType for the inner loop.

[Anonymous]

Thanks Pavlos

This worked for me:

_
Public Sub SampleHatch()

Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Using trans As Transaction = db.TransactionManager.StartTransaction() 'Start the transaction.

Try

Dim Opts As New PromptSelectionOptions()

Dim filList() As TypedValue = {New TypedValue(DxfCode.Start, "LWPOLYLINE"), New TypedValue(DxfCode.LayerName, "0")}

Dim filter As SelectionFilter = New SelectionFilter(filList)
Dim res As PromptSelectionResult = ed.GetSelection(Opts, filter)

If Not res.Status = PromptStatus.OK Then Return

Dim objSet As Autodesk.AutoCAD.EditorInput.SelectionSet = res.Value

Dim idArray As ObjectId() = objSet.GetObjectIds

ed.WriteMessage("Selected --> " & objSet.Count)

'
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim hatch As Hatch = New Autodesk.AutoCAD.DatabaseServices.Hatch
'for each ent as Entity in
hatch.SetHatchPattern(HatchPatternType.PreDefined, "ANSI32")
hatch.Normal = New Vector3d(0, 0, 1)
hatch.Elevation = 0.0
hatch.ColorIndex = 4
hatch.Associative = False
'hatch.UpgradeOpen()
btr.AppendEntity(hatch)
trans.AddNewlyCreatedDBObject(hatch, True)


Dim loopID As ObjectId
For Each loopID In idArray
Dim objcol As ObjectIdCollection = New Autodesk.AutoCAD.DatabaseServices.ObjectIdCollection
objcol.Add(loopID)
hatch.AppendLoop(HatchLoopTypes.Default, objcol)
Next
hatch.EvaluateHatch(False)


trans.Commit()

bt.Dispose()
btr.Dispose()
db.Dispose()
Catch ex As System.Exception
MsgBox(ex.Message)
Finally
trans.Dispose()
End Try
End Using

End Sub

~'J'~

[cyranobb30]

Might check my mistake please?

[Alexander.Rivilis]

---

@cyranobb30 wrote:

Might check my mistake please?

---

Mistake in which code?

[cyranobb30]

Thank you for answering I have many months trying to solve this.
In short it is a routine (netlog). It consists of a polyline, and hatch one text within.
The routine works perfect. See Rutina.jpg
The problem is that it gives an error when I try to run it from vb.net. See Error.jpg

THIS IS MY CODE
' Open the Block table for read
Dim acBlkTbl1 As BlockTable
acBlkTbl1 = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

Dim acBlkTblRec1 As BlockTableRecord

acBlkTblRec1 = acTrans.GetObject(acBlkTbl1(BlockTableRecord.ModelSpace),
OpenMode.ForWrite)

Using acPoly As Polyline = New Polyline() 'Creamos una Polilinea
acPoly.AddVertexAt(0, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)
acPoly.AddVertexAt(1, New Point2d(coordenadaX - (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
acPoly.AddVertexAt(2, New Point2d(coordenadaX + (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
acPoly.AddVertexAt(3, New Point2d(coordenadaX + (8.97 * escala), coordenadaY), 0, 0, 0)
acPoly.AddVertexAt(4, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)

acBlkTblRec1.AppendEntity(acPoly)
acTrans.AddNewlyCreatedDBObject(acPoly, True)

acPoly.Closed = True 'Cerrar la polylinea

Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection() 'Agregar la polilinea y otros objetos a una unica seleccion

acObjIdColl.Add(acPoly.ObjectId)

Using acText As DBText = New DBText()
acText.HorizontalMode = TextHorizontalMode.TextCenter
acText.Position = New Point3d(coordenadaX - (0 * escala), coordenadaY + (2 * escala), 0)
acText.AlignmentPoint = New Point3d(coordenadaX - (0 * escala), coordenadaY + (2 * escala), 0)

acText.Height = 3 * escala

acText.TextString = numval

acBlkTblRec1.AppendEntity(acText)
acTrans.AddNewlyCreatedDBObject(acText, True)

Using acHatch As Hatch = New Hatch() 'Definimos un hatch para los objetos en la coleccion
acBlkTblRec1.AppendEntity(acHatch) 'Lo agregamos al block table recordset que es donde dibujamos
acTrans.AddNewlyCreatedDBObject(acHatch, True) 'Asigno las propiedades del objeto

acHatch.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")
acHatch.Associative = True

Select Case colorvalvula
Case 1
acHatch.ColorIndex = 2
Case 2
acHatch.ColorIndex = 3
Case 3
acHatch.ColorIndex = 5
Case 4
acHatch.ColorIndex = 1
Case 5
acHatch.ColorIndex = 4
Case 6
acHatch.ColorIndex = 6
Case 7
acHatch.ColorIndex = 30
Case 8
acHatch.ColorIndex = 9
Case 9
acHatch.ColorIndex = 202
Case 10
acHatch.ColorIndex = 52
Case Else
acHatch.ColorIndex = 7
End Select

acHatch.AppendLoop(HatchLoopTypes.Outermost, acObjIdColl)

acObjIdColl.Clear()
acObjIdColl.Add(acText.ObjectId)

'' Append the circle as the inner loop of the hatch and evaluate it
acHatch.AppendLoop(HatchLoopTypes.Default, acObjIdColl)

acHatch.EvaluateHatch(True)

End Using

[cyranobb30]

anything you need
my skype
the entire file etc

Thank you very much hope will be something very simple and can help

[Alexander.Rivilis]

It's just a piece of code that I can not verify because there are not many variables which used in this code (coordenadaX, coordenadaY, escala, etc...)

Also for posting code there is special button which you can use in order to your code will be useful for read:

[Alexander.Rivilis]

In order to check your code I need full code. 

[cyranobb30]

No problem this is my complete code

also attached the netlog file. This work perfect

But if you run this code in vb.net give me error

thank you very much for your help

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows
Imports Autodesk.AutoCAD.LayerManager.LayerFilter
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Colors
Imports System.IO
Public Class ValvulaRiego
    Public CapaActiva As String
    Public x As Double
    Public xn As Double
    Public xc As Double
    Public esc As Double
    Public escala As Double

    <CommandMethod("valvulariego")>
    Public Sub InsertingABlock()
        ' Get the current database and start a transaction
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Autodesk.AutoCAD.DatabaseServices.Database
        acCurDb = Application.DocumentManager.MdiActiveDocument.Database
        TestFont()
        Dim pPtRes As PromptPointResult
        Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")

        '' Prompt for a point
        pPtOpts.Message = vbLf & "Ingrese el Punto de Inserción "
        pPtRes = acDoc.Editor.GetPoint(pPtOpts)
        Dim coordenadaX As Double
        Dim coordenadaY As Double
        Dim numval As Double
        Dim area As Double
        Dim valorarea As Double
        Dim caudal As Double
        Dim prec As Double
        Dim precip1 As Double
        Dim escala1 As Double
        Dim colorvalvula As Double
        Dim colorht As Double
        If esc = 1 Or esc = 0 Then
            esc = 1
        End If
        If xc = 1 Or x = 0 Then
            xc = 1
        End If
        If x = 1.05 Or x = 0 Then
            x = 1.05
        End If
        If xn = 0 Then
            xn = 0
        End If
        valorarea = AreaObjeto(area)
        precip1 = Precipitacion(prec)
        caudal = precip1 * 10 * valorarea / 10000
        numval = valvula(numval)
        numval = CStr(numval)
        colorvalvula = ColorHatch(colorht)
        escala = 4 * FunEscala(escala1)
        coordenadaX = pPtRes.Value.X
        coordenadaY = pPtRes.Value.Y
        'escala = 4

        'Application.ShowAlertDialog("Prec: " & precip1)     'Obtener mensaje
        CreandoLayer()

        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            ' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

            Dim blkRecId As ObjectId = ObjectId.Null

            If Not acBlkTbl.Has("BloqueValvula") Then
                Using acBlkTblRec As New BlockTableRecord
                    acBlkTblRec.Name = "BloqueValvula"

                    ' Set the insertion point for the block
                    acBlkTblRec.Origin = New Point3d(coordenadaX, coordenadaY, 0)

                    Using acPoly As Polyline = New Polyline()                  'Creamos una Polilinea
                        acPoly.AddVertexAt(0, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)
                        acPoly.AddVertexAt(1, New Point2d(coordenadaX - (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
                        acPoly.AddVertexAt(2, New Point2d(coordenadaX + (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
                        acPoly.AddVertexAt(3, New Point2d(coordenadaX + (8.97 * escala), coordenadaY), 0, 0, 0)
                        acPoly.AddVertexAt(4, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)

                        Using acPoly1 As Polyline = New Polyline()
                            acPoly1.AddVertexAt(0, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)
                            acPoly1.AddVertexAt(1, New Point2d(coordenadaX - (8.97 * escala), coordenadaY - (4.5 * escala)), 0, 0, 0)
                            acPoly1.AddVertexAt(2, New Point2d(coordenadaX - (4.97 * escala), coordenadaY - (11.5 * escala)), 0, 0, 0)
                            acPoly1.AddVertexAt(3, New Point2d(coordenadaX + (4.97 * escala), coordenadaY - (11.5 * escala)), 0, 0, 0)
                            acPoly1.AddVertexAt(4, New Point2d(coordenadaX + (8.97 * escala), coordenadaY - (4.5 * escala)), 0, 0, 0)
                            acPoly1.AddVertexAt(5, New Point2d(coordenadaX + (8.97 * escala), coordenadaY), 0, 0, 0)
                            acPoly1.AddVertexAt(6, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)

                            Using acPoly2 As Polyline = New Polyline()
                                acPoly2.AddVertexAt(0, New Point2d(coordenadaX - (8.97 * escala), coordenadaY - (4.5 * escala)), 0, 0, 0)
                                acPoly2.AddVertexAt(1, New Point2d(coordenadaX + (8.97 * escala), coordenadaY - (4.5 * escala)), 0, 0, 0)

                                Using acPoly3 As Line = New Line(New Point3d(coordenadaX, coordenadaY - (4.5 * escala), 0), New Point3d(coordenadaX, coordenadaY - (11.5 * escala), 0))

                                    Using acText1 As DBText = New DBText()
                                        'acText1.SetDatabaseDefaults()

                                        acText1.Position = New Point3d(coordenadaX - (8.086 * escala), coordenadaY - (3.0989 * escala), 0)
                                        acText1.Height = 2 * escala
                                        'MsgBox(escala)
                                        acText1.TextString = "Area ="

                                        Using acText5 As DBText = New DBText()
                                            acText5.Position = New Point3d(coordenadaX + (3.6809 * escala), coordenadaY - (8.3832 * escala), 0)
                                            acText5.Height = 2 * escala
                                            acText5.TextString = """ "

                                            Using acText6 As DBText = New DBText()
                                                acText6.Position = New Point3d(coordenadaX - (4.4073 * escala), coordenadaY - (10.7812 * escala), 0)
                                                acText6.Height = 1 * escala
                                                acText6.TextString = "m" & Chr(179) & "/h"

                                                Using acText7 As DBText = New DBText()
                                                    acText7.Position = New Point3d(coordenadaX + (2.22 * escala), coordenadaY - (10.78 * escala), 0)
                                                    acText7.Height = 1.5 * escala
                                                    acText7.TextString = Chr(248)

                                                    acBlkTblRec.AppendEntity(acPoly)
                                                    acBlkTblRec.AppendEntity(acPoly1)
                                                    acBlkTblRec.AppendEntity(acPoly2)
                                                    acBlkTblRec.AppendEntity(acPoly3)
                                                    acBlkTblRec.AppendEntity(acText1)
                                                    acBlkTblRec.AppendEntity(acText5)
                                                    acBlkTblRec.AppendEntity(acText6)
                                                    acBlkTblRec.AppendEntity(acText7)

                                                    acBlkTbl.UpgradeOpen()
                                                    acBlkTbl.Add(acBlkTblRec)
                                                    acTrans.AddNewlyCreatedDBObject(acBlkTblRec, True)

                                                End Using
                                            End Using
                                        End Using
                                    End Using
                                End Using
                            End Using
                        End Using
                    End Using
                    blkRecId = acBlkTblRec.Id
                End Using
            Else
                blkRecId = acBlkTbl("BloqueValvula")
            End If

            ' Insert the block into the current space
            If blkRecId <> ObjectId.Null Then
                Using acBlkRef As New BlockReference(New Point3d(coordenadaX, coordenadaY, 0), blkRecId)

                    Dim acCurSpaceBlkTblRec As BlockTableRecord
                    acCurSpaceBlkTblRec = acTrans.GetObject(acCurDb.CurrentSpaceId, OpenMode.ForWrite)
                    acBlkRef.ScaleFactors = New Scale3d(esc, esc, esc)
                    acCurSpaceBlkTblRec.AppendEntity(acBlkRef)
                    acTrans.AddNewlyCreatedDBObject(acBlkRef, True)
                End Using
            End If

            'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
            ' Open the Block table for read
            Dim acBlkTbl1 As BlockTable
            acBlkTbl1 = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

            Dim acBlkTblRec1 As BlockTableRecord

            acBlkTblRec1 = acTrans.GetObject(acBlkTbl1(BlockTableRecord.ModelSpace),
            OpenMode.ForWrite)

            Using acPoly As Polyline = New Polyline()                  'Creamos una Polilinea
                acPoly.AddVertexAt(0, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)
                acPoly.AddVertexAt(1, New Point2d(coordenadaX - (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
                acPoly.AddVertexAt(2, New Point2d(coordenadaX + (4.97 * escala), coordenadaY + (7 * escala)), 0, 0, 0)
                acPoly.AddVertexAt(3, New Point2d(coordenadaX + (8.97 * escala), coordenadaY), 0, 0, 0)
                acPoly.AddVertexAt(4, New Point2d(coordenadaX - (8.97 * escala), coordenadaY), 0, 0, 0)

                acBlkTblRec1.AppendEntity(acPoly)
                acTrans.AddNewlyCreatedDBObject(acPoly, True)

                acPoly.Closed = True 'Cerrar la polylinea

                Dim acObjIdColl As ObjectIdCollection = New ObjectIdCollection()  'Agregar la polilinea y otros objetos a una unica seleccion

                acObjIdColl.Add(acPoly.ObjectId)

                Using acText As DBText = New DBText()
                    acText.HorizontalMode = TextHorizontalMode.TextCenter
                    acText.Position = New Point3d(coordenadaX - (0 * escala), coordenadaY + (2 * escala), 0)
                    acText.AlignmentPoint = New Point3d(coordenadaX - (0 * escala), coordenadaY + (2 * escala), 0)

                    acText.Height = 3 * escala

                    acText.TextString = numval

                    acBlkTblRec1.AppendEntity(acText)
                    acTrans.AddNewlyCreatedDBObject(acText, True)

                    Using acHatch As Hatch = New Hatch() 'Definimos un hatch para los objetos en la coleccion
                        acBlkTblRec1.AppendEntity(acHatch) 'Lo agregamos al block table recordset que es donde dibujamos
                        acTrans.AddNewlyCreatedDBObject(acHatch, True) 'Asigno las propiedades del objeto

                        acHatch.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")
                        acHatch.Associative = True

                        Select Case colorvalvula
                            Case 1
                                acHatch.ColorIndex = 2
                            Case 2
                                acHatch.ColorIndex = 3
                            Case 3
                                acHatch.ColorIndex = 5
                            Case 4
                                acHatch.ColorIndex = 1
                            Case 5
                                acHatch.ColorIndex = 4
                            Case 6
                                acHatch.ColorIndex = 6
                            Case 7
                                acHatch.ColorIndex = 30
                            Case 8
                                acHatch.ColorIndex = 9
                            Case 9
                                acHatch.ColorIndex = 202
                            Case 10
                                acHatch.ColorIndex = 52
                            Case Else
                                acHatch.ColorIndex = 7
                        End Select

                        acHatch.AppendLoop(HatchLoopTypes.Outermost, acObjIdColl)

                        acObjIdColl.Clear()
                        acObjIdColl.Add(acText.ObjectId)

                        '' Append the circle as the inner loop of the hatch and evaluate it
                        acHatch.AppendLoop(HatchLoopTypes.Default, acObjIdColl)

                        acHatch.EvaluateHatch(True)

                    End Using

                    Using acText2 As DBText = New DBText()
                        acText2.HorizontalMode = TextHorizontalMode.TextCenter
                        acText2.Position = New Point3d(coordenadaX + (4.9375 * escala), coordenadaY - (3.1032 * escala), 0)
                        acText2.AlignmentPoint = New Point3d(coordenadaX + (4.9375 * escala), coordenadaY - (3.1032 * escala), 0)

                        acText2.Height = 2 * escala
                        acText2.TextString = FormatNumber(CStr(valorarea / 10000), 2) '"50.22"

                        acBlkTblRec1.AppendEntity(acText2)
                        acTrans.AddNewlyCreatedDBObject(acText2, True)

                        Using acText3 As DBText = New DBText()

                            acText3.HorizontalMode = TextHorizontalMode.TextCenter
                            acText3.Position = New Point3d(coordenadaX - (3.39115 * escala), coordenadaY - (8.3832 * escala), 0)
                            acText3.AlignmentPoint = New Point3d(coordenadaX - (3.39115 * escala), coordenadaY - (8.3832 * escala), 0)

                            Select Case caudal
                                Case 0 To 9.99
                                    acText3.Height = 2 * escala
                                Case 10 To 99.99
                                    acText3.Height = 2 * escala
                                Case 100 To 999.99
                                    acText3.Height = 1.6 * escala
                            End Select

                            acText3.TextString = FormatNumber(CStr(caudal), 1) ' "20.2"

                            acBlkTblRec1.AppendEntity(acText3)
                            acTrans.AddNewlyCreatedDBObject(acText3, True)

                            Using acText4 As DBText = New DBText()
                                acText4.Position = New Point3d(coordenadaX + (2.0251 * escala), coordenadaY - (8.3832 * escala), 0)
                                acText4.Height = 2 * escala
                                Select Case caudal
                                    Case 0 To 32
                                        acText4.TextString = "2"
                                    Case 32 To 65
                                        acText4.TextString = "3"
                                    Case 65 To 500
                                        acText4.TextString = "4"
                                End Select

                                acBlkTblRec1.AppendEntity(acText4)
                                acTrans.AddNewlyCreatedDBObject(acText4, True)

                            End Using
                        End Using
                    End Using
                    'acPoly.Erase()
                End Using
            End Using
            '' Open the Layer table for read
            Dim acLyrTbl As LayerTable
            acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId,
                                         OpenMode.ForRead)
            Dim sLayerName As String = CapaActiva
            acCurDb.Clayer = acLyrTbl(sLayerName)
            'MsgBox("Current Layer: " + CapaActiva)

            ' Save the new object to the database
            acTrans.Commit()

            ' Dispose of the transaction
        End Using
    End Sub
    Public Sub CreandoLayer()
        '' Get the current document and database
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database

        '' Start a transaction
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

            '' Open the Layer table for read
            Dim acLyrTbl As LayerTable
            acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId,
                                         OpenMode.ForRead)

            Dim lt As LayerTable = CType(acTrans.GetObject(acCurDb.LayerTableId, OpenMode.ForRead), LayerTable)
            Dim ltr As LayerTableRecord = CType(acTrans.GetObject(acCurDb.Clayer, OpenMode.ForRead), LayerTableRecord)
            'MsgBox("Current Layer: " + ltr.Name)
            CapaActiva = ltr.Name


            Dim sLayerName As String = "Poligono"

            If acLyrTbl.Has(sLayerName) = False Then
                Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()

                '' Assign the layer the ACI color 1 and a name
                acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, 7)
                acLyrTblRec.Name = sLayerName

                '' Upgrade the Layer table for write
                acLyrTbl.UpgradeOpen()

                '' Append the new layer to the Layer table and the transaction

                acLyrTbl.Add(acLyrTblRec)
                acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
                acCurDb.Clayer = acLyrTbl(sLayerName)
            Else
                '' Set the layer Center current
                acCurDb.Clayer = acLyrTbl(sLayerName)

            End If

            acTrans.Commit()
        End Using
    End Sub
    Public Function FunEscala(ByRef escala1 As Double)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim pIntOpts As PromptDoubleOptions = New PromptDoubleOptions("")
        pIntOpts.Message = vbCrLf & "Ingrese el valor de la Escala "

        '' Restrict input to positive and non-negative values
        pIntOpts.AllowZero = False
        pIntOpts.AllowNegative = False

        '' Define the valid keywords and allow Enter  Chr(216) chr(248)
        pIntOpts.Keywords.Add(CStr(esc))

        pIntOpts.Keywords.Default = CStr(esc)
        pIntOpts.AllowNone = True
        'obtener el valor ingresado por el usuario
        Dim pIntRes As PromptDoubleResult = acDoc.Editor.GetDouble(pIntOpts)

        If pIntRes.Status = PromptStatus.Keyword Then
            esc = pIntOpts.Keywords.Default
        Else
            esc = CDbl(pIntRes.Value)
        End If
        Return esc
    End Function
    Public Function Precipitacion(ByRef prec As Double)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim pIntOpts As PromptDoubleOptions = New PromptDoubleOptions("")
        pIntOpts.Message = vbCrLf & "Ingrese el valor de la precipitacion (mm/h) "

        '' Restrict input to positive and non-negative values
        pIntOpts.AllowZero = False
        pIntOpts.AllowNegative = False

        '' Define the valid keywords and allow Enter  Chr(216) chr(248)
        pIntOpts.Keywords.Add(CStr(x))
        'pIntOpts.Keywords.Add("Small")
        'pIntOpts.Keywords.Add("Regular")
        pIntOpts.Keywords.Default = CStr(x)
        pIntOpts.AllowNone = True
        'obtener el valor ingresado por el usuario
        Dim pIntRes As PromptDoubleResult = acDoc.Editor.GetDouble(pIntOpts)
        'Dim x As Double
        ' x = pIntRes.Value        CInt(Int(txtPrice.Text))

        If pIntRes.Status = PromptStatus.Keyword Then
            'Application.ShowAlertDialog("Entered keyword: " & pIntRes.StringResult)
            'Application.ShowAlertDialog("Entered keyword: " & x)
            x = pIntOpts.Keywords.Default
        Else
            ' Application.ShowAlertDialog("Entered value: " & pIntRes.Value.ToString())
            'Application.ShowAlertDialog("Entered keyword: " & x)
            x = CDbl(pIntRes.Value)
        End If
        Return x
    End Function
    Private Function valvula(ByRef valc As Double)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim pIntOpts As PromptDoubleOptions = New PromptDoubleOptions("")
        pIntOpts.Message = vbCrLf & "Ingrese el número de Válvula "

        '' Restrict input to positive and non-negative values
        pIntOpts.AllowZero = False
        pIntOpts.AllowNegative = False

        '' Define the valid keywords and allow Enter  Chr(216) chr(248)
        pIntOpts.Keywords.Add(CStr(xn + 1))

        'pIntOpts.Keywords.Add("Small")
        'pIntOpts.Keywords.Add("Regular")
        pIntOpts.Keywords.Default = CStr(xn + 1)
        pIntOpts.AllowNone = True

        'obtener el valor ingresado por el usuario
        Dim pIntRes As PromptDoubleResult = acDoc.Editor.GetDouble(pIntOpts)
        'Dim v As Double
        ' x = pIntRes.Value        CInt(Int(txtPrice.Text))

        If pIntRes.Status = PromptStatus.Keyword Then
            'Application.ShowAlertDialog("Entered keyword: " & pIntRes.StringResult)
            'Application.ShowAlertDialog("Entered keyword: " & x)
            xn = pIntOpts.Keywords.Default
        Else
            ' Application.ShowAlertDialog("Entered value: " & pIntRes.Value.ToString())
            'Application.ShowAlertDialog("Entered keyword: " & x)
            xn = CDbl(pIntRes.Value)
        End If
        Return xn
    End Function
    Private Function ColorHatch(ByRef colorht As Double)
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim pIntOpts As PromptDoubleOptions = New PromptDoubleOptions("")
        pIntOpts.Message = vbCrLf & "Ingrese el turno de riego "

        '' Restrict input to positive and non-negative values
        pIntOpts.AllowZero = False
        pIntOpts.AllowNegative = False

        '' Define the valid keywords and allow Enter  Chr(216) chr(248)
        pIntOpts.Keywords.Add(1)
        pIntOpts.Keywords.Add(2)
        pIntOpts.Keywords.Add(3)
        pIntOpts.Keywords.Add(4)
        pIntOpts.Keywords.Add(5)
        pIntOpts.Keywords.Add(6)
        pIntOpts.Keywords.Add(7)
        pIntOpts.Keywords.Default = CStr(xc)
        pIntOpts.AllowNone = True

        'obtener el valor ingresado por el usuario
        Dim pIntRes As PromptDoubleResult = acDoc.Editor.GetDouble(pIntOpts)

        ' x = pIntRes.Value        CInt(Int(txtPrice.Text))

        If pIntRes.Status = PromptStatus.Keyword Then
            'Application.ShowAlertDialog("Entered keyword: " & pIntRes.StringResult)
            'Application.ShowAlertDialog("Entered keyword: " & x)
            xc = pIntOpts.Keywords.Default
        Else
            ' Application.ShowAlertDialog("Entered value: " & pIntRes.Value.ToString())
            'Application.ShowAlertDialog("Entered keyword: " & x)
            xc = CDbl(pIntRes.Value)
        End If
        Return xc
    End Function
    Private Function AreaObjeto(ByRef area As Double)
        '' Get the current document and database
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim ed As Editor = acDoc.Editor
        Dim area1 As Double
        Dim total1 As Double
        Dim i As Double
        Dim array(100) As Double
        i = 0
        '' Start a transaction

        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

            '' Request for objects to be selected in the drawing area
            Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection()

            '' If the prompt status is OK, objects were selected
            If acSSPrompt.Status = PromptStatus.OK Then
                Dim acSSet As SelectionSet = acSSPrompt.Value

                '' Step through the objects in the selection set
                For Each acSSObj As SelectedObject In acSSet

                    '' Check to make sure a valid SelectedObject object was returned
                    If Not IsDBNull(acSSObj) Then
                        '' Open the selected object for write
                        Dim acEnt As Entity = acTrans.GetObject(acSSObj.ObjectId,
                                                                OpenMode.ForWrite)
                        Dim obj As DBObject = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForRead)

                        If Not IsDBNull(acEnt) Then
                            '' Change the object's color to Green

                            If TypeOf (obj) Is Circle Then
                                Dim circ As Circle = CType(obj, Circle)
                                Dim StrMsg As String = "Manolo, Círculo de área " & circ.Area.ToString("F1") & " m2"
                                ed.WriteMessage(StrMsg)

                                area1 = circ.Area.ToString("F2")

                                i = i + 1
                                array(i) = area1
                                'Application.ShowAlertDialog("Circulo area: " & array(i) & "Contador" & i)

                            End If

                            If TypeOf (obj) Is Polyline2d Then
                                Dim poli2d As Polyline2d = CType(obj, Polyline2d)
                                ' ...
                                'poli2d.UpgradeOpen()
                                'poli2d.Closed = True
                                'If poli2d.Closed = True Then
                                Dim StrMsg As String = "Polilínea2D de área " & poli2d.Area.ToString("F2") & " m2"
                                    ed.WriteMessage(StrMsg)
                                    area1 = poli2d.Area.ToString("F1")
                                    i = i + 1
                                    array(i) = area1
                                'End If
                                'Application.ShowAlertDialog("Polilinea area: " & array(i) & "Contador" & i)
                            End If

                            If TypeOf (obj) Is Polyline Then
                                Dim poli As Polyline = CType(obj, Polyline)
                                ' ...
                                'If poli.Closed = True Then ' Se debe tener cuidado de que este cerrada la polilinea
                                Dim StrMsg As String = "Polilínea de área " & poli.Area.ToString("F2") & " m2"
                                    ed.WriteMessage(StrMsg)
                                    area1 = poli.Area.ToString("F1")
                                    i = i + 1
                                    array(i) = area1
                                'End If
                                'Application.ShowAlertDialog("Polilinea area: " & array(i) & "Contador" & i)
                            End If

                            If TypeOf (obj) Is Region Then
                                Dim regi As Region = CType(obj, Region)
                                'CultureInfo.InvariantCulture
                                ' ...
                                Dim StrMsg As String = "Región de área " & regi.Area.ToString("F2") & " m2"
                                ed.WriteMessage(StrMsg)
                                area1 = regi.Area.ToString("F1")
                                i = i + 1
                                array(i) = area1
                                'Application.ShowAlertDialog("Region area: " & array(i) & "Contador" & i)
                            End If

                        End If
                    End If
                Next
                For i = 0 To 99
                    total1 = total1 + array(i)
                Next
                i = 0
                '' Save the new object to the database
                acTrans.Commit()
            End If

            '' Dispose of the transaction
        End Using
        Return total1
    End Function
    Public Shared Sub TestFont()

        Dim doc As Document =
                   Application.DocumentManager.MdiActiveDocument
        Dim db As Database =
                    doc.Database
        Dim tm As Transaction =
                        db.TransactionManager.StartTransaction()

        Dim ed As Editor = doc.Editor

        Using tm

            Dim st1 As TextStyleTable = tm.GetObject(db.TextStyleTableId, OpenMode.ForRead)

            Dim st As TextStyleTable = CType(tm.GetObject(
                            db.TextStyleTableId,
                            OpenMode.ForWrite, False),
                                             TextStyleTable)
            Dim str As TextStyleTableRecord =
                                    New TextStyleTableRecord()


            If st.Has("StyleValve") = False Then
                st.UpgradeOpen()
                str.Name = "StyleValve"
                st.Add(str)

                str.Font = New Autodesk.AutoCAD.GraphicsInterface.FontDescriptor("Arial", True, False, Nothing, Nothing)
                tm.AddNewlyCreatedDBObject(str, True)

                db.Textstyle = str.ObjectId
            Else
                db.Textstyle = st("StyleValve")
            End If
            tm.Commit()
            tm.Dispose()
        End Using

    End Sub
End Class

[Alexander.Rivilis]

Sorry but I did not found error. So I can not understand what you want and what needs help. The code works:

[cyranobb30]

Hello Friend
You can try to run it from vb.net. please
There you can see the error.

[Alexander.Rivilis]

Ok. I start debugging with VS 2015. No error:

What wrong?

[cyranobb30]

Thank you friend
I do not understand
Well I have no way to make a video. Which program do you use?
To me it gives me the error that you attached to the image and all text disappear.

[Alexander.Rivilis]

For creating video you can use Autodesk Screencast: https://knowledge.autodesk.com/community/screencast

I think it is a problem with debugging settings of your VS. Set "Use managed compatibility mode":

Read this post: http://through-the-interface.typepad.com/through_the_interface/2013/11/debugging-autocad-using-visua...

[cyranobb30]

Thanks Alexander Rivilis
I have spent months putting in long hours but this probblema. You have helped me a lot
Study agriculture, I have not been programming. But thanks to sites like this I could do routines that help me a lot in my work
I made the simple change you provided me and everything worked perfect.
Blessings.
Now I didicare to try to create a routine to divide areas. Although likely to last 50 times more than anyone else, I love this.