By Adam Nagy
Here is a sample put together from other DevBlog posts that show how you can Wblock the slected entities into a new database, create there a viewport and zoom it to the extents of the newly added entities.
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports acApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.Geometry
Public Class Commands
<CommandMethod("RunTest")> _
Public Sub RunTest()
Using db As Database = CreateDrawing()
Using tr As Transaction =
db.TransactionManager.StartTransaction()
Dim vp As Viewport = CreateViewport(db)
ZoomExtents(vp)
tr.Commit()
End Using
db.SaveAs("C:\\temp.dwg", DwgVersion.Current)
End Using
End Sub
Public Function CreateDrawing() As Database
Dim ed As Editor = acApp.DocumentManager.MdiActiveDocument.Editor
Dim psr As PromptSelectionResult = ed.SelectAll()
If psr Is Nothing Then Return Nothing
Dim db As Database = ed.Document.Database
Dim newDb As New Database(True, True)
Dim ids As New ObjectIdCollection(psr.Value.GetObjectIds())
db.Wblock( _
newDb, ids, New Point3d(), DuplicateRecordCloning.Replace)
Return newDb
End Function
Public Function CreateViewport(ByVal db As Database) As Viewport
Dim bt As BlockTable =
db.BlockTableId.GetObject(OpenMode.ForRead)
Dim ps As BlockTableRecord =
bt(BlockTableRecord.PaperSpace).GetObject(OpenMode.ForWrite)
Dim vp As New Viewport()
vp.Height = 100
vp.Width = 100
ps.AppendEntity(vp)
db.TransactionManager.AddNewlyCreatedDBObject(vp, True)
Return vp
End Function
Public Sub ZoomExtents(ByVal vp As Viewport)
Dim db As Database = vp.Database
' get the screen aspect ratio to calculate
' the height and width
Dim mScrRatio As Double
' width/height
mScrRatio = (vp.Width / vp.Height)
db.UpdateExt(True)
Dim mMaxExt As Point3d = db.Extmax
Dim mMinExt As Point3d = db.Extmin
Dim mExtents As New Extents3d(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 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()
End Sub
End Class