<CommandMethod("BatchExport")> _
Public Sub BatchExport()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim fb As New Windows.Forms.FolderBrowserDialog
fb.Description = "Search for folder containing files needing converted."
fb.SelectedPath = Path.GetDirectoryName(doc.Name)
If fb.ShowDialog() = Windows.Forms.DialogResult.OK Then
Dim folderPath As String = fb.SelectedPath
Dim files() As String = Directory.GetFiles(folderPath, "*.dwg")
For Each file As String In files
Dim dwtDB As New Database(False, False)
Dim newFile As String = ""
dwtDB.ReadDwgFile("\\fileserver\TEMPLATE_20130408.dwt", FileShare.ReadWrite, False, "")
Dim dwgDB As New Database(False, False)
dwgDB.ReadDwgFile(file, FileShare.ReadWrite, False, "")
Dim objCol As New ObjectIdCollection()
Using tr As Transaction = dwgDB.TransactionManager.StartTransaction
Dim bt As BlockTable = tr.GetObject(dwgDB.BlockTableId, OpenMode.ForRead, False)
Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead)
For Each id As ObjectId In btr
objCol.Add(id)
Next
End Using
dwgDB.Wblock(dwtDB, objCol, Point3d.Origin, DuplicateRecordCloning.Ignore)
Using extTr As Transaction = dwtDB.TransactionManager.StartTransaction()
HostApplicationServices.WorkingDatabase = dwtDB
Dim layoutMgr As LayoutManager = LayoutManager.Current
ed.WriteMessage("Number of layouts = {0}" & vbLf, layoutMgr.LayoutCount)
ed.WriteMessage("Current layout = {0}" & vbLf, layoutMgr.CurrentLayout)
Using layoutDict As DBDictionary = extTr.GetObject(dwtDB.LayoutDictionaryId, OpenMode.ForRead)
For Each layoutEntry As DictionaryEntry In layoutDict
Using layoutObj As Layout = TryCast(extTr.GetObject(DirectCast(layoutEntry.Value, ObjectId), OpenMode.ForRead), Layout)
If Not layoutObj.LayoutName.ToUpper = "MODEL" Then
layoutMgr.CurrentLayout = layoutObj.LayoutName
Dim r As BlockTableRecord = extTr.GetObject(layoutObj.BlockTableRecordId, OpenMode.ForRead)
For Each obj As ObjectId In r
Dim dbObj As DBObject = extTr.GetObject(obj, OpenMode.ForRead)
Dim vp As Autodesk.AutoCAD.DatabaseServices.Viewport = TryCast(dbObj, Autodesk.AutoCAD.DatabaseServices.Viewport)
If vp IsNot Nothing Then
ed.WriteMessage(vbLf & "number of Viewport = {0}", vp.Number)
' get the screen aspect ratio to calculate
' the height and width
Dim mScrRatio As Double
' width/height
mScrRatio = (vp.Width / vp.Height)
Dim mMaxExt As Point3d = dwgDB.Extmax
Dim mMinExt As Point3d = dwgDB.Extmin
Dim mExtents As New Extents3d()
mExtents.Set(mMinExt, mMaxExt)
' prepare Matrix for DCS to WCS transformation
Dim matWCS2DCS As Matrix3d
matWCS2DCS = Matrix3d.PlaneToWorld(vp.ViewDirection)
matWCS2DCS = Matrix3d.Displacement(vp.ViewTarget - Point3d.Origin) * matWCS2DCS
matWCS2DCS = Matrix3d.Rotation(-vp.TwistAngle, vp.ViewDirection, vp.ViewTarget) * matWCS2DCS
matWCS2DCS = matWCS2DCS.Inverse()
' tranform the extents to the DCS
' defined by the viewdir
mExtents.TransformBy(matWCS2DCS)
' width of the extents in current view
Dim mWidth As Double
mWidth = (mExtents.MaxPoint.X - mExtents.MinPoint.X)
' height of the extents in current view
Dim mHeight As Double
mHeight = (mExtents.MaxPoint.Y - mExtents.MinPoint.Y)
' get the view center point
Dim mCentPt As New Point2d(((mExtents.MaxPoint.X + mExtents.MinPoint.X) * 0.5), ((mExtents.MaxPoint.Y + mExtents.MinPoint.Y) * 0.5))
' check if the width 'fits' in current window,
' if not then get the new height as
' per the viewports aspect ratio
If mWidth > (mHeight * mScrRatio) Then
mHeight = mWidth / mScrRatio
End If
' set the viewport parameters
If vp.Number = 2 Then
vp.UpgradeOpen()
' set the view height - adjusted by 1%
vp.ViewHeight = mHeight * 1.01
' set the view center
vp.ViewCenter = mCentPt
vp.Visible = True
vp.On = True
vp.UpdateDisplay()
'ed.SwitchToModelSpace()
Application.SetSystemVariable("CVPORT", vp.Number)
End If
If vp.Number = 3 Then
vp.UpgradeOpen()
vp.ViewHeight = mHeight * 1.25
'set the view center
vp.ViewCenter = mCentPt
vp.Visible = True
vp.On = True
vp.UpdateDisplay()
'ed.SwitchToModelSpace()
Application.SetSystemVariable("CVPORT", vp.Number)
End If
End If
Next
End If
End Using
Next
End Using
extTr.Commit()
End Using
Try
newFile = folderPath & "\_" & Path.GetFileName(file)
dwtDB.SaveAs(newFile, DwgVersion.AC1024)
Catch ex As System.Exception
Application.ShowAlertDialog(ex.Message)
End Try
dwtDB.Dispose()
dwgDB.Dispose()
HostApplicationServices.WorkingDatabase = db
Next
End If
End Sub
