Private Class LayerDets
Private mLayerName As String = ""
Public Property LayerName() As String
Get
Return mLayerName
End Get
Set(ByVal value As String)
mLayerName = value
End Set
End Property
Public LayerObjectID As ObjectId = ObjectId.Null
Private mLineTypeName As String = ""
Public Property LineTypeName() As String
Get
Return mLineTypeName
End Get
Set(ByVal value As String)
mLineTypeName = value
End Set
End Property
Public LinetypeObjectID As ObjectId = ObjectId.Null
Public LineWeightOBJ As LineWeight = LineWeight.ByLayer
Public Transparency As Autodesk.AutoCAD.Colors.Transparency
Private mLayerColor As Autodesk.AutoCAD.Colors.Color
Public WriteOnly Property LayerColor() As Autodesk.AutoCAD.Colors.Color
Set(ByVal value As Autodesk.AutoCAD.Colors.Color)
mLayerColor = value
End Set
End Property
Public ReadOnly Property LayerColorObj() As Autodesk.AutoCAD.Colors.Color
Get
Return mLayerColor
End Get
End Property
Public ReadOnly Property LayerColorName() As String
Get
Return mLayerColor.ColorIndex.ToString
End Get
End Property
Private mDescription As String
Public Property Description() As String
Get
Return mDescription
End Get
Set(ByVal value As String)
mDescription = value
End Set
End Property
Private mIsPlotable As Boolean = False
Private mIsFrozen As Boolean = False
Private mIsOff As Boolean = False
Private mIsLocked As Boolean = False
Public Property IsPlotAble() As Boolean
Get
Return mIsPlotable
End Get
Set(ByVal value As Boolean)
mIsPlotable = value
End Set
End Property
Public Property IsLocked() As Boolean
Get
Return mIsLocked
End Get
Set(ByVal value As Boolean)
mIsLocked = value
End Set
End Property
Public Property IsOff() As Boolean
Get
Return mIsOff
End Get
Set(ByVal value As Boolean)
mIsOff = value
End Set
End Property
Public Property IsFrozen() As Boolean
Get
Return mIsFrozen
End Get
Set(ByVal value As Boolean)
mIsFrozen = value
End Set
End Property
End Class
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 = ""
'Create List Of class to store data about layers
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)
'ignore Layer '0' and also check to make sure that this is one of the layers selected in the dialog box
If SourceLayer.Name <> "0" AndAlso LayerNames.Contains(SourceLayer.Name.ToUpper) Then
'Initaliase CLass
Dim NewLay As New LayerDets
'set layer name
NewLay.LayerName = SourceLayer.Name
'Get LayerObjectOID - Not really needed
NewLay.LayerObjectID = SourceLayer.ObjectId
'Get Color Object
NewLay.LayerColor = SourceLayer.Color
'Get LineWeight - Need to test is this need WBObjectCloning
NewLay.LineWeightOBJ = SourceLayer.LineWeight
'Set LineType Information
Dim LineTypeRec As LinetypeTableRecord = TryCast(tr.GetObject(SourceLayer.LinetypeObjectId, OpenMode.ForRead), LinetypeTableRecord)
NewLay.LineTypeName = LineTypeRec.Name
NewLay.LinetypeObjectID = SourceLayer.LinetypeObjectId
NewLay.IsOff = SourceLayer.IsOff
NewLay.IsFrozen = SourceLayer.IsFrozen
NewLay.IsPlotAble = SourceLayer.IsPlottable
NewLay.IsLocked = SourceLayer.IsLocked
NewLay.Transparency = SourceLayer.Transparency
'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 LineTye object ID is not Null (As in Continuous)
If Det.LinetypeObjectID <> ObjectId.Null AndAlso Det.LineTypeName <> "Continuous" Then
'Add it for Cloning anyway
Dim CloneLTOIDS As New ObjectIdCollection
CloneLTOIDS.Add(Det.LinetypeObjectID)
Dim idMapLT As IdMapping = New IdMapping()
SourceDB.WblockCloneObjects(CloneLTOIDS, CurrentLineTypeTable.ObjectId, idMapLT, ReplaceOrIgnore, False)
Det.LinetypeObjectID = CurrentLineTypeTable(Det.LineTypeName)
End If
'Check to see if current layer exists
If CurrentLayerTable.Has(Det.LayerName) = True Then
'It exists now Overright only of the CheckBox is tick in Form
If chkOverWriteLayer.Checked = True Then
'Over write properties
Dim layerTableRec As LayerTableRecord = DirectCast(tr2.GetObject(CurrentLayerTable(Det.LayerName), OpenMode.ForWrite), LayerTableRecord)
If Det.LayerColorObj IsNot Nothing Then
layerTableRec.Color = Det.LayerColorObj
End If
If Det.LinetypeObjectID <> ObjectId.Null Then
layerTableRec.LinetypeObjectId = Det.LinetypeObjectID
End If
layerTableRec.Description = Det.Description
layerTableRec.LineWeight = Det.LineWeightOBJ
layerTableRec.IsOff = Det.IsOff
layerTableRec.IsFrozen = Det.IsFrozen
layerTableRec.IsPlottable = Det.IsPlotAble
layerTableRec.IsLocked = Det.IsLocked
layerTableRec.Transparency = Det.Transparency
End If
Else
Dim NewLayer As New LayerTableRecord
NewLayer.Name = Det.LayerName
CurrentLayerTable.Add(NewLayer)
tr2.AddNewlyCreatedDBObject(NewLayer, True)
If Det.LayerColorObj IsNot Nothing Then
NewLayer.Color = Det.LayerColorObj
End If
If Det.LinetypeObjectID <> ObjectId.Null Then
NewLayer.LinetypeObjectId = Det.LinetypeObjectID
End If
NewLayer.Description = Det.Description
NewLayer.LineWeight = Det.LineWeightOBJ
NewLayer.IsOff = Det.IsOff
NewLayer.IsFrozen = Det.IsFrozen
NewLayer.IsPlottable = Det.IsPlotAble
NewLayer.IsLocked = Det.IsLocked
NewLayer.Transparency = Det.Transparency
End If
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