<CommandMethod("CreateMasterDWG")> _
Public Sub MasterTest()
Dim document As Document = Application.DocumentManager.MdiActiveDocument
document.SendStringToExecute("_.ucs ", True, False, False)
document.SendStringToExecute("top ", True, False, False)
document.SendStringToExecute("_qsave ", True, False, False)
Dim editor As Editor = document.Editor
Dim database As Database = document.Database
Dim curdir2 As String = Path.GetDirectoryName(fName2)
Dim frm1 As New frmBlockCreator
Dim strFileName As String
frm1.SaveFileDialog1.InitialDirectory = curdir2
frm1.SaveFileDialog1.Title = "Select a location to save the master file."
frm1.SaveFileDialog1.Filter = "Drawing Files|*.dwg"
frm1.SaveFileDialog1.AddExtension = True
If frm1.SaveFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
strFileName = frm1.SaveFileDialog1.FileName
Else
Exit Sub
End If
Dim db As Database = New Database(True, False)
Try
Using trans2 As Transaction = db.TransactionManager.StartTransaction()
db.SaveAs(strFileName, DwgVersion.Newest)
End Using
Catch ex As System.Exception
End Try
Dim oidc As New ObjectIdCollection()
Try
Using trans As Transaction = database.TransactionManager.StartTransaction()
Dim btr As BlockTable = DirectCast(trans.GetObject(database.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btrMs As BlockTableRecord = TryCast(btr(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead), BlockTableRecord)
'go through each object in the block table record
For Each entID As ObjectId In btrMs
'create variable used to determine is it is a block reference
Dim ent As Entity = trans.GetObject(entID, OpenMode.ForRead, False)
'if it is a block then perform code below
If TypeOf ent Is BlockReference Then
Dim blkRef As BlockReference = TryCast(trans.GetObject(entID, OpenMode.ForRead, False), BlockReference)
Dim bid As ObjectId = blkRef.BlockTableRecord
Dim blocktr As BlockTableRecord = DirectCast(trans.GetObject(bid, OpenMode.ForRead), BlockTableRecord)
If blocktr.IsFromExternalReference Then
Dim btrpathname As String = blocktr.PathName.ToString
Dim strFileDir As String = Path.GetFileNameWithoutExtension(strFileName)
Dim strSaveDir As String = Path.GetDirectoryName(strFileName)
Dim strBlockName As String = blkRef.Name
Dim db2 As Database = New Database(True, False)
'read newly created dwg file
db2.ReadDwgFile(strFileName, FileShare.ReadWrite, False, "")
Using trx As Transaction = db2.TransactionManager.StartTransaction()
Dim xrefBt As BlockTable = trx.GetObject(db2.BlockTableId, OpenMode.ForWrite)
Dim btrMs2 As BlockTableRecord = trx.GetObject(xrefBt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'create objectID for XRef
Dim xrid As ObjectId = db2.AttachXref(btrpathname, Path.GetFileNameWithoutExtension(btrpathname))
'create block reference, reference the xref objectID
Dim bref As New BlockReference(blkRef.Position, xrid)
'bref.Rotation = blkRef.Rotation
'bref.ScaleFactors = blkRef.ScaleFactors
bref.BlockTransform = blkRef.BlockTransform
'append xref to blocktable
btrMs2.AppendEntity(bref)
Dim blname As String = "XRef - " & Path.GetFileNameWithoutExtension(btrpathname)
'Get the layer table first...
Dim lt As LayerTable = trx.GetObject(db2.LayerTableId, OpenMode.ForRead)
Dim layerId As ObjectId = ObjectId.Null
'Check if EmployeeLayer exists...
If lt.Has(blname) Then
layerId = lt.Item(blname)
Else
'If not, create the layer here.
lt.UpgradeOpen()
Dim ltr As LayerTableRecord = New LayerTableRecord()
ltr.Name = blname ' Set the layer name
ltr.Color = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByAci, 7)
layerId = lt.Add(ltr)
trx.AddNewlyCreatedDBObject(ltr, True)
End If
'trx.Commit()
bref.LayerId = layerId
trx.AddNewlyCreatedDBObject(bref, True)
db2.SaveAs(strFileName, DwgVersion.Current)
End Using
'End If
End If
Dim attRefIds As AttributeCollection = blkRef.AttributeCollection
'cycle through the attributes associated with the current block
For Each attrefid As ObjectId In attRefIds
Dim attref As AttributeReference = trans.GetObject(attrefid, OpenMode.ForRead, False)
Select Case attref.Tag
'if block has attribute PartNumber then create the wblock
Case "PartNumber"
Dim strBlockName As String = blkRef.Name
Dim btrid As ObjectId = If(blkRef.IsDynamicBlock, blkRef.DynamicBlockTableRecord, blkRef.BlockTableRecord)
Dim btr2 As BlockTableRecord = DirectCast(trans.GetObject(btrid, OpenMode.ForRead), BlockTableRecord)
If btr2.IsLayout OrElse btr2.IsAnonymous OrElse btr2.IsFromExternalReference OrElse btr2.IsFromOverlayReference Then
editor.WriteMessage(vbLf & "Cannot convert block {0} to Xref. ", btr2.Name)
Else
Dim ok As Boolean = False
'Add block objectID
Dim oidc2 As New ObjectIdCollection
oidc2.Add(blkRef.ObjectId)
Dim strFileDir As String = Path.GetFileNameWithoutExtension(strFileName)
Dim strSaveDir As String = Path.GetDirectoryName(strFileName)
Dim strFileDirTrim As String = Mid(strFileDir, 1, 4)
If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Views") Then
Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Views")
End If
If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Parts") Then
Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Parts")
End If
If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Construction") Then
Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Construction")
End If
If Not Directory.Exists(strSaveDir & "\" & strFileDir & " - Study") Then
Directory.CreateDirectory(strSaveDir & "\" & strFileDir & " - Study")
End If
Using target As Database = New Database(False, False)
target.ReadDwgFile("\\fs\drivers\CAD STANDARDS\Blocks\Templates\PART DRAWING 2012 EPICOR.dwt", FileShare.ReadWrite, False, "")
database.Wblock(target, oidc2, Point3d.Origin, DuplicateRecordCloning.Replace)
target.SaveAs(strSaveDir & "\" & strFileDir & " - parts\" & strBlockName & ".dwg", DwgVersion.Newest)
ok = True
End Using
If ok Then
Dim strPartFile As String = strSaveDir & "\" & strFileDir & " - Parts\" & strBlockName & ".dwg"
Dim db2 As Database = New Database(False, False)
'read newly created dwg file
db2.ReadDwgFile(strFileName, FileShare.ReadWrite, False, "")
Using trx As Transaction = db2.TransactionManager.StartTransaction()
Dim xrefBt As BlockTable = trx.GetObject(db2.BlockTableId, OpenMode.ForWrite)
Dim btrMs2 As BlockTableRecord = trx.GetObject(xrefBt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
'create objectID for XRef
Dim xrid As ObjectId = db2.AttachXref(strPartFile, Path.GetFileNameWithoutExtension(strPartFile))
'create block reference, reference the xref objectID
Dim bref As New BlockReference(blkRef.Position, xrid)
bref.BlockTransform = blkRef.BlockTransform
btrMs2.AppendEntity(bref)
Dim blname As String = "XRef - " & Path.GetFileNameWithoutExtension(strPartFile)
'Get the layer table first...
Dim lt As LayerTable = trx.GetObject(db2.LayerTableId, OpenMode.ForRead)
Dim layerId As ObjectId = ObjectId.Null
'Check if EmployeeLayer exists...
If lt.Has(blname) Then
layerId = lt.Item(blname)
Else
'If not, create the layer here.
lt.UpgradeOpen()
Dim ltr As LayerTableRecord = New LayerTableRecord()
ltr.Name = blname ' Set the layer name
ltr.Color = Autodesk.AutoCAD.Colors.Color.FromColorIndex(Autodesk.AutoCAD.Colors.ColorMethod.ByAci, 7)
layerId = lt.Add(ltr)
trx.AddNewlyCreatedDBObject(ltr, True)
End If
'trx.Commit()
bref.LayerId = layerId
trx.AddNewlyCreatedDBObject(bref, True)
db2.SaveAs(strFileName, DwgVersion.Current)
trx.Commit()
End Using
End If
End If
End Select
Next
End If
Next
End Using
Catch ex As System.Exception
Windows.MessageBox.Show("Error occurred: " & ex.Message, "Error", Windows.MessageBoxButton.OK, Windows.MessageBoxImage.Error)
End Try
End Sub
