Add Linetype to Layer

[Anonymous]

I have a sub that creates a layer from selected database, I can't seem to find the variables needed to add a linetype here's the code;


Dim layerId As ObjectId 'the return value for this function
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Try
'Get the layer table first, open for read as it may already be there
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
Dim ltdb As LinetypeTable = trans.GetObject(db.LinetypeTableId, OpenMode.ForRead)

'Check if Layer exists...
If lt.Has(layern) Then
layerId = lt.Item(layern)
Else
'If not, create the layer here.
Dim ltr As LayerTableRecord = New LayerTableRecord()
ltr.Name = layern 'Set the layer name
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, PENN)
ltr.Description = DES
Dim ltrid As LinetypeTableRecord = New LinetypeTableRecord()


'Lost at this point






' it doesn't exist so add it, but first upgrade the open to write
lt.UpgradeOpen()
layerId = lt.Add(ltr)
trans.AddNewlyCreatedDBObject(ltr, True)
ltr.Description = DES
trans.Commit()

[Mikko]

You need the objectid of the linetype, something like this:


Dim hiddenlineId As ObjectId


Dim lt As LayerTable = t.GetObject(db.LayerTableId, OpenMode.ForWrite)
If lt.Has(LayName) Then
layerId = lt.Item(LayName)
Else
Call LoadLineTypes()
Dim ltr As LayerTableRecord = New LayerTableRecord
ltr.Name = LayName
ltr.LinetypeObjectId = hiddenlineId
layerId = lt.Add(ltr)
t.AddNewlyCreatedDBObject(ltr, True)
End If


Sub LoadLineTypes()
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Try
db.LoadLineTypeFile("Hidden", "acad.lin")
Catch ex As Exception
End Try
Dim tbl As LinetypeTable = t.GetObject(db.LinetypeTableId, OpenMode.ForRead, False)
Try
hiddenlineId = tbl("Hidden")
Catch ex As Exception
End Try
t.Commit()
t.Dispose()
End Sub

[Anonymous]

This is great, but I'm working within a loop which pulls a linetype from the dataset and saves it to string, would i Place the sub load line type's before to loop or in it.
I like the ideal of making the 'Dim hiddenlineId As ObjectId' as I can pass the varible to this.

Here's The entire Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim layern As String = ""
Dim PENN As String = ""
Dim DES As String = ""
'Dim LTY As String = ""
Dim obj As System.Data.DataRowView
Dim obj1 As System.Data.DataRowView
Dim obj2 As System.Data.DataRowView
Dim obj3 As System.Data.DataRowView

For Each obj In ListBox1.SelectedItems
layern = CType(obj.Item("Layer"), String)
DES = CType(obj.Item("DESCRIPTION"), String)
PENN = CType(obj.Item("PEN"), String)
'LTY = CType(obj.Item("LINETYPE"), String)
Dim layerId As ObjectId 'the return value for this function
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Try
'Get the layer table first, open for read as it may already be there
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
Dim ltdb As LinetypeTable = trans.GetObject(db.LinetypeTableId, OpenMode.ForRead)

'Check if Layer exists...
If lt.Has(layern) Then
layerId = lt.Item(layern)
Else
'If not, create the layer here.
Dim ltr As LayerTableRecord = New LayerTableRecord()
ltr.Name = layern 'Set the layer name
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, PENN)
ltr.Description = DES
'Dim ltrid As LinetypeTableRecord = New LinetypeTableRecord()


'Lost at this point






' it doesn't exist so add it, but first upgrade the open to write
lt.UpgradeOpen()
layerId = lt.Add(ltr)
trans.AddNewlyCreatedDBObject(ltr, True)
ltr.Description = DES
trans.Commit()

End If
Catch ex As System.Exception
MsgBox("Error in CreateLayer Command" + ex.Message)
Finally
trans.Dispose()
End Try
Next

Me.Close()
End Sub

[Mikko]

Use a function to return your linetypeId as the variable you need to set.


Function LineTypeId(ByVal typeline As String) As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
db.LoadLineTypeFile(typeline, "acad.lin")
Dim tbl As LinetypeTable = t.GetObject(db.LinetypeTableId, OpenMode.ForRead, False)
LineTypeId = tbl(typeline)
t.Commit()
t.Dispose()
End Function


Try
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
If lt.Has(LayName) Then
layerId = lt.Item(LayName)
Else
Dim ltr As LayerTableRecord = New LayerTableRecord
ltr.Name = layern 'Set the layer name
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, PENN)
ltr.LinetypeObjectId = LineTypeId(LTY)
ltr.Description = DES
layerId = lt.Add(ltr)
t.AddNewlyCreatedDBObject(ltr, True)
End If
t.Commit()
Catch ex As System Exception
MsgBox("Error in CreateLayer Command" + ex.Message)
Finally
trans.Dispose()
End Try Message was edited by: Mikko

[Anonymous]

Making it a function Public/private creates a fatal error in AutoCAD..

[Anonymous]

Error Is undefined Linetype

Here's the code;
Public Function LineTypeId(ByVal typeline As String) As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
db.LoadLineTypeFile(typeline, "acad.lin")
Dim tbl As LinetypeTable = t.GetObject(db.LinetypeTableId, OpenMode.ForRead, False)
LineTypeId = tbl(typeline)
t.Commit()
t.Dispose()
End Function

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim layern As String = ""
Dim PENN As String = ""
Dim DES As String = ""
Dim LTY As String = ""
Dim obj As System.Data.DataRowView

For Each obj In ListBox1.SelectedItems
layern = CType(obj.Item("Layer"), String)
DES = CType(obj.Item("DESCRIPTION"), String)
PENN = CType(obj.Item("PEN"), String)
LTY = CType(obj.Item("LINETYPE"), String)
Dim layerId As ObjectId 'the return value for this function
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim trans As Transaction = db.TransactionManager.StartTransaction()

Try
'Get the layer table first, open for read as it may already be there
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
'Check if Layer exists...
If lt.Has(layern) Then
layerId = lt.Item(layern)
Else
'If not, create the layer here.
Dim ltr As LayerTableRecord = New LayerTableRecord()
ltr.Name = layern 'Set the layer name
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, PENN)
ltr.LinetypeObjectId = LineTypeId(LTY)
' it doesn't exist so add it, but first upgrade the open to write
layerId = lt.Add(ltr)
trans.AddNewlyCreatedDBObject(ltr, True)
ltr.Description = DES
trans.Commit()

End If
Catch ex As System.Exception
MsgBox("Error in CreateLayer Command" + ex.Message)
Finally
trans.Dispose()
End Try
Next

Me.Close()
End Sub

[Mikko]

Is the linetype your pulling from your dataset an AutoCAD LineType?

Here is a quick 20 minute demo... had to try this out myself and a dwg
that was saved from inventor


Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.EditorInput

Public Class Class1

Dim visibleId As ObjectId
Dim hiddenId As ObjectId
Dim centerId As ObjectId
Dim dimensionId As ObjectId
Dim partId As ObjectId
Dim part2Id As ObjectId
Dim movementId As ObjectId
Dim interfaceequipId As ObjectId
Dim interfaceequip2Id As ObjectId
Dim balloonId As ObjectId

<CommandMethod("ChangeLayers", CommandFlags.Session)> _
Public Sub ChangeLayers()
Dim foundFile As String = ""
Dim fbd As New Windows.Forms.FolderBrowserDialog
Dim ThisOne As String = ""
If fbd.ShowDialog() = Windows.Forms.DialogResult.OK Then
ThisOne = fbd.SelectedPath
Else
MsgBox("You must select a Folder")
Exit Sub
End If
Dim docLock As DocumentLock
For Each foundFile In My.Computer.FileSystem.GetFiles(ThisOne, FileIO.SearchOption.SearchAllSubDirectories, "*.dwg")
Dim docs As Autodesk.AutoCAD.ApplicationServices.DocumentCollection
docs = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager
Dim doc As Autodesk.AutoCAD.ApplicationServices.Document = docs.Open(foundFile, False)
docLock = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument()
Call SetMyLayers()
Call This2That_Layers()
docLock.Dispose()
doc.CloseAndSave(foundFile)
Next
End Sub

Public Sub SetMyLayers()
visibleId = CheckForLayer("my01", 7, "Continuous")
hiddenId = CheckForLayer("my02", 2, "Hidden")
centerId = CheckForLayer("my03", 6, "Center")
dimensionId = CheckForLayer("my04", 3, "Continuous")
partId = CheckForLayer("my05", 5, "Phantom")
part2Id = CheckForLayer("my06", 1, "Phantom")
movementId = CheckForLayer("my07", 4, "Phantom2")
interfaceequipId = CheckForLayer("my08", 30, "Phantom")
interfaceequip2Id = CheckForLayer("my09", 201, "Phantom")
balloonId = CheckForLayer("BallnStock", 146, "Continuous")
End Sub

Public Function CheckForLayer(ByVal namLay As String, ByVal colLay As Integer, ByVal typLin As String) As ObjectId
Dim layerId As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Dim lt As LayerTable = t.GetObject(db.LayerTableId, OpenMode.ForWrite)
If lt.Has(namLay) Then
layerId = lt.Item(namLay)
Else
Dim ltr As LayerTableRecord = New LayerTableRecord
ltr.Name = namLay
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, colLay)
If typLin <> "Continuous" Then ltr.LinetypeObjectId = CheckForLineType(typLin)
layerId = lt.Add(ltr)
t.AddNewlyCreatedDBObject(ltr, True)
End If
t.Commit()
t.Dispose()
Return layerId
End Function

Public Function CheckForLineType(ByVal typeline As String) As ObjectId
Dim linetypeId As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Dim tbl As LinetypeTable = t.GetObject(db.LinetypeTableId, OpenMode.ForRead, False)
If tbl.Has(typeline) Then
linetypeId = tbl(typeline)
Else
db.LoadLineTypeFile(typeline, "acad.lin")
linetypeId = tbl(typeline)
End If
t.Commit()
t.Dispose()
Return linetypeId
End Function

Sub This2That_Layers()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Dim psr As PromptSelectionResult
Dim idArray() As ObjectId
Dim objId As ObjectId
Dim ent As Entity

Try
Dim filterfor() As TypedValue = {New TypedValue(8, "Hidden (ANSI)")}
Dim sf As SelectionFilter = New SelectionFilter(filterfor)
psr = ed.SelectAll(sf)
If psr.Status = PromptStatus.OK Then
Dim ss As Autodesk.AutoCAD.EditorInput.SelectionSet = psr.Value
idArray = ss.GetObjectIds()
For Each objId In idArray
ent = t.GetObject(objId, OpenMode.ForWrite, False)
ent.LayerId = hiddenId
ent.Color = Color.FromColorIndex(ColorMethod.ByLayer, 256)
ent.Linetype = SymbolUtilityServices.LinetypeByLayerName()
Next objId
End If
Catch ex As Exception
Finally
psr = Nothing
idArray = Nothing
objId = Nothing
ent = Nothing
End Try

t.Commit()
t.Dispose()
End Sub

End Class

[Anonymous]

I can get the function to work but I get this error after it creates the layer."Error in createLayer CommandekeyNot Found"..

code;

Private Sub CREATDIALOG_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'PWGSCDataSet.Selected_Layers' table. You can move, or remove it, as needed.
Me.Selected_LayersTableAdapter.Fill(Me.PWGSCDataSet.Selected_Layers)
Dim x As Integer
' Loop through all items the ListBox.
For x = 0 To ListBox1.Items.Count - 1
' Select all items that are not selected.
ListBox1.SetSelected(x, True)
ListBox2.SetSelected(x, True)
ListBox3.SetSelected(x, True)
ListBox4.SetSelected(x, True)
Next x
Dim db As Database = HostApplicationServices.WorkingDatabase
db.LoadLineTypeFile("*", "acad.lin")
End Sub

Private Sub Button2_Click(ByVal sender As System.Object,
Public Function LineTypeId(ByVal typeline As String) As ObjectId
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim t As Transaction = db.TransactionManager.StartTransaction()
Dim tbl As LinetypeTable = t.GetObject(db.LinetypeTableId, OpenMode.ForRead, False)
LineTypeId = tbl(typeline)
t.Commit()
t.Dispose()
End Function


Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim layern As String = ""
Dim PENN As String = ""
Dim DES As String = ""
Dim LTY As String = ""
Dim obj As System.Data.DataRowView

For Each obj In ListBox1.SelectedItems
layern = CType(obj.Item("Layer"), String)
DES = CType(obj.Item("DESCRIPTION"), String)
PENN = CType(obj.Item("PEN"), String)
LTY = CType(obj.Item("LINETYPE"), String)
Dim layerId As ObjectId 'the return value for this function
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim trans As Transaction = db.TransactionManager.StartTransaction()
Try
'Get the layer table first, open for read as it may already be there
Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
'Dim ltdb As LinetypeTable = trans.GetObject(db.LinetypeTableId, OpenMode.ForRead)


'Check if Layer exists...
If lt.Has(layern) Then
layerId = lt.Item(layern)
Else
'If not, create the layer here.
Dim ltr As LayerTableRecord = New LayerTableRecord()
'Set the layer name
ltr.Name = layern
ltr.Color = Color.FromColorIndex(ColorMethod.ByAci, PENN)
ltr.LinetypeObjectId = LineTypeId(LTY)
layerId = lt.Add(ltr)
trans.AddNewlyCreatedDBObject(ltr, True)
ltr.Description = DES
End If
trans.Commit()
Catch ex As System.Exception
MsgBox("Error in CreateLayer Command" + ex.Message)
Finally
trans.Dispose()
End Try
Next

Me.Close()
End Sub

[Anonymous]

It looks like it's failling on to many layers / it will make up to 27 then error..Any ideas how to stop this?

[Anonymous]

I appreciate your help, I have made the app similar to your posting using functions, Unfourtunstely I still runing into this creation error, without line type i can creat an infinate number of layers. With linetype it error on 79 layers and crashes autocad eventually. I think this has to do with the dispose commands. Just a guese..

[Mikko]

I added a loop to SetMyLayers that adds hundreds of layers.
Doesn't seem to have any problem.

Public Sub SetMyLayers()
For i As Integer = 90 To 1 Step -1
visibleId = CheckForLayer("my01" & i.ToString, 7, "Continuous")
hiddenId = CheckForLayer("my02" & i.ToString, 2, "Hidden")
centerId = CheckForLayer("my03" & i.ToString, 6, "Center")
dimensionId = CheckForLayer("my04" & i.ToString, 3, "Continuous")
partId = CheckForLayer("my05" & i.ToString, 5, "Phantom")
part2Id = CheckForLayer("my06" & i.ToString, 1, "Phantom")
movementId = CheckForLayer("my07" & i.ToString, 4, "Phantom2")
interfaceequipId = CheckForLayer("my08" & i.ToString, 30, "Phantom")
interfaceequip2Id = CheckForLayer("my09" & i.ToString, 201, "Phantom")
balloonId = CheckForLayer("BallnStock" & i.ToString, 146, "Continuous")
Next
End Sub

[Anonymous]

Could it be that I'm pulling the variables from a dataset?

[Mikko]

It shouldn't. I tried it against a Web Service with the table in SQL Sever with no problems.

Public Sub SetMyLayers()
Dim ws As New longhorn.Service
Dim dt As System.Data.DataTable = ws.Layers.Tables(0)
Dim dv As New DataView(dt)
Dim drv As DataRowView
For Each drv In dv
Select Case drv("LayerDescription")
Case "Visible"
visibleId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Center"
centerId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Dimension"
dimensionId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Hidden"
hiddenId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Main Part"
partId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Secondary Part"
part2Id = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Motion"
movementId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Interface1 Equipment"
interfaceequipId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Interface2 Equipment"
interfaceequip2Id = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case "Ball-n-Stock"
balloonId = CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
Case Else
CheckForLayer(drv("LayerName"), drv("LayerColor"), drv("LayerLinetype"))
End Select
Next
End Sub

[Anonymous]

Thanks for your continued assistance, I'm posting the refined code if you can see anything that jumps out as wrong please let me know, I going to try refining some more?

[Anonymous]

I solved It, After all the searching I went back to the dataset and found some spelling errors in the linetype idenification.. I feel so stupid..Thanks for all your help..