.NET

Reply
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 1 of 15 (186 Views)

Add Linetype to Layer

186 Views, 14 Replies
09-14-2006 10:09 AM
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()
Distinguished Contributor
Mikko
Posts: 212
Registered: ‎10-03-2003
Message 2 of 15 (186 Views)

Re: Add Linetype to Layer

09-14-2006 12:03 PM in reply to: Littlerubarbwk
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
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 3 of 15 (186 Views)

Re: Add Linetype to Layer

09-14-2006 01:55 PM in reply to: Littlerubarbwk
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
Distinguished Contributor
Mikko
Posts: 212
Registered: ‎10-03-2003
Message 4 of 15 (186 Views)

Re: Add Linetype to Layer

09-15-2006 03:37 AM in reply to: Littlerubarbwk
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
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 5 of 15 (186 Views)

Re: Add Linetype to Layer

09-18-2006 09:51 AM in reply to: Littlerubarbwk
Making it a function Public/private creates a fatal error in AutoCAD..
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 6 of 15 (186 Views)

Re: Add Linetype to Layer

09-18-2006 10:20 AM in reply to: Littlerubarbwk
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
Distinguished Contributor
Mikko
Posts: 212
Registered: ‎10-03-2003
Message 7 of 15 (186 Views)

Re: Add Linetype to Layer

09-18-2006 11:37 AM in reply to: Littlerubarbwk
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
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 8 of 15 (186 Views)

Re: Add Linetype to Layer

09-18-2006 01:10 PM in reply to: Littlerubarbwk
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
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 9 of 15 (186 Views)

Re: Add Linetype to Layer

09-18-2006 02:20 PM in reply to: Littlerubarbwk
It looks like it's failling on to many layers / it will make up to 27 then error..Any ideas how to stop this?
Active Contributor
Littlerubarbwk
Posts: 38
Registered: ‎09-08-2006
Message 10 of 15 (186 Views)

Re: Add Linetype to Layer

09-19-2006 08:55 AM in reply to: Littlerubarbwk
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..
Post to the Community

Have questions about Autodesk products? Ask the community.

New Post
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.