Private Function ImportLayersFromFile(ByVal SourceFileName As String, ByVal LayerNames As List(Of String)) As String
Dim CurrentDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = CurrentDoc.Editor()
'Get orignal drawing
Dim CurrentDB As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Dim Result As String = ""
Dim LDets As List(Of LayerDets) = New List(Of LayerDets)
Try
'lock the current drawing
Using DokLock As DocumentLock = CurrentDoc.LockDocument
'Read source Drawing
Dim SourceDB As Database = New Database(True, False)
SourceDB.ReadDwgFile(SourceFileName, System.IO.FileShare.Read, False, "")
'start Transaction
Using tr As Transaction = SourceDB.TransactionManager.StartTransaction()
'Make the working database the new database
HostApplicationServices.WorkingDatabase = SourceDB
'Get Layer Table
Dim SourceLayerTable As LayerTable = TryCast(tr.GetObject(SourceDB.LayerTableId, OpenMode.ForRead), LayerTable)
Dim SourceLineTypeTable As LinetypeTable = TryCast(tr.GetObject(SourceDB.LinetypeTableId, OpenMode.ForRead), LinetypeTable)
'Get Each layer from Layer Table
For Each LayerObjectID As ObjectId In SourceLayerTable
'set Layer Infomation
Dim SourceLayer As LayerTableRecord = TryCast(tr.GetObject(LayerObjectID, OpenMode.ForRead, False), LayerTableRecord)
If SourceLayer.Name <> "0" AndAlso LayerNames.Contains(SourceLayer.Name.ToUpper) Then
'Initaliase CLass
Dim NewLay As New LayerDets
NewLay.LayerName = SourceLayer.Name
NewLay.LayerObjectID = SourceLayer.ObjectId
'Set LineType Information
Dim LineTypeRec As LinetypeTableRecord = TryCast(tr.GetObject(SourceLayer.LinetypeObjectId, OpenMode.ForRead), LinetypeTableRecord)
If LineTypeRec.Name <> "Continuous" Then
NewLay.LineTypeName = LineTypeRec.Name
NewLay.LinetypeObjectID = SourceLayer.LinetypeObjectId
End If
'Add to Class List
LDets.Add(NewLay)
End If
Next
'Make the original database the working database
HostApplicationServices.WorkingDatabase = CurrentDB
Using tr2 As Transaction = CurrentDB.TransactionManager.StartTransaction()
'Get existing Layer and Linetype Tables
Dim CurrentLayerTable As LayerTable = TryCast(tr2.GetObject(CurrentDB.LayerTableId, OpenMode.ForWrite), LayerTable)
Dim CurrentLineTypeTable As LinetypeTable = TryCast(tr2.GetObject(CurrentDB.LinetypeTableId, OpenMode.ForWrite), LinetypeTable)
'Step thru each Layer to copy over
For Each Det As LayerDets In LDets
'Set Replace / Ignore based on Check Box in Dialog
Dim ReplaceOrIgnore As DuplicateRecordCloning = If(chkOverWriteLayer.Checked <> False, DuplicateRecordCloning.Replace, DuplicateRecordCloning.Ignore)
If Det.LinetypeObjectID <> ObjectId.Null Then
Dim CloneLTOIDS As New ObjectIdCollection
CloneLTOIDS.Add(Det.LinetypeObjectID)
Dim idMapLT As IdMapping = New IdMapping()
SourceDB.WblockCloneObjects(CloneLTOIDS, CurrentLineTypeTable.ObjectId, idMapLT, ReplaceOrIgnore, False)
End If
Dim CloneLayOIDS As New ObjectIdCollection
CloneLayOIDS.Add(Det.LayerObjectID)
Dim idMapLay As IdMapping = New IdMapping()
SourceDB.WblockCloneObjects(CloneLayOIDS, CurrentLayerTable.ObjectId, idMapLay, ReplaceOrIgnore, False) '<- Crash eOutOfRange
Next
Result = "Layers Imported from " & SourceFileName & vbCrLf
tr2.Commit()
End Using
tr.Commit()
End Using
End Using
Catch ex As Exception
Result = ex.ToString
End Try
Return Result
End Function