Create Multiple Layers using VB.NET

[tdunkerley]

Hello All, I do not know programming but through the help of samples I am able to pull together what I need to get many things to work. However, I am lost on this one and could really use some help. I know in VBA the code is similar where you list all the layers you want to create then it adds them to the collection. I was thinking that in .NET it would work kind of the same way, lol nope. This is my code could one of you very talented programmers please tell me what is missing from this code to make it work. Thank you in advance.

<CommandMethod("ADDPNL")>
Private Sub ADDPNL()

'On Error Resume Next

Dim acDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
'' Start a transaction
Using m_tm As Transaction = acCurDb.TransactionManager.StartTransaction()

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

Dim sLayerName As String
sLayerName = "TEST1"
sLayerName = "TEST2"
sLayerName = "TEST3"
sLayerName = "TEST4"

Using acLyrTblRec As LayerTableRecord = New LayerTableRecord()

'' Assign the layer the ACI color 3 and a name
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)
m_tm.AddNewlyCreatedDBObject(acLyrTblRec, True)

'' Save the changes and dispose of the transaction
m_tm.Commit()
End Using

If True Then Resume Next
End Using
End Sub

[hippe013 · Accepted solution]

You pretty much have it. Each layer would need to be added individually. You declare a variable called sLayerName and set its value to "Test1". You then overwrite the value with "Test2" and then "Test3", and finally "Test4". So the only layer you are creating is "Test4". Also, you should be checking to see if the layer name already exists. 

The following is a quick example of adding layers and assigning a color. 

<CommandMethod("LayerAddExample")>
Public Sub CmdLayerAddExample()
   Dim aDoc As Document = Application.DocumentManager.MdiActiveDocument
   Dim db As Database = aDoc.Database
   Dim ed As Editor = aDoc.Editor

   Using tr As Transaction = db.TransactionManager.StartTransaction
      Dim lyrTbl As LayerTable = tr.GetObject(db.LayerTableId, OpenMode.ForWrite)

      If Not lyrTbl.Has("Test1") Then
         'Create a Layer with the Name Test1 and the color Red (Index 1)
         Dim layer As New LayerTableRecord With {.Name = "Test1", .Color = Color.FromColorIndex(ColorMethod.ByAci, 1)}
         lyrTbl.Add(layer)
         tr.AddNewlyCreatedDBObject(layer, True)
      Else
         ed.WriteMessage(vbCrLf & "Layer 'Test1' already exists.")
      End If

      If Not lyrTbl.Has("Test2") Then
         'Create a Layer with the Name Test2 and the color Yellow (Index 2)
         Dim layer As New LayerTableRecord With {.Name = "Test2", .Color = Color.FromColorIndex(ColorMethod.ByAci, 2)}
         lyrTbl.Add(layer)
         tr.AddNewlyCreatedDBObject(layer, True)
      Else
         ed.WriteMessage(vbCrLf & "Layer 'Test2' already exists.")
      End If

      If Not lyrTbl.Has("Test3") Then
         'Create a Layer with the Name Test3 and the color Green (Index 3)
         Dim layer As New LayerTableRecord With {.Name = "Test3", .Color = Color.FromColorIndex(ColorMethod.ByAci, 3)}
         lyrTbl.Add(layer)
         tr.AddNewlyCreatedDBObject(layer, True)
      Else
         ed.WriteMessage(vbCrLf & "Layer 'Test3' already exists.")
      End If

      tr.Commit()
   End Using
End Sub

[tdunkerley · Accepted solution]

Thank you so much, So I see to do it they have to be declared individually and not as a collection of layers to add. I was trying to make it loop through each one and create them. Now I know, thank you for the quick solution..

[hippe013 · Accepted solution]

The layers can be added in a For Next Loop. It appears to me that you were using the old VBA resume next. I'm not very familiar with the older VBA style of coding.  

 For i As Integer = 1 To 4
   Dim layName As String = "Test" & i.ToString
   If Not lyrTbl.Has(layName) Then
      Dim layer As New LayerTableRecord With {.Name = layName, .Color = Color.FromColorIndex(ColorMethod.ByAci, i)}
      lyrTbl.Add(layer)
      tr.AddNewlyCreatedDBObject(layer, True)
   End If
Next