Thank you! It worked partially, I have a loop that selects entities in an open document and saves in newdb. It worked in the first loop, but in the second loop the result of the wrong selection
Public Function ExportSelection(PathToExport As String, pt3min As Point3d, pt3max As Point3d, DimScale As Double, LtScale As Double, Version As DwgVersion) As Boolean
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim prRes As PromptSelectionResult = ed.SelectWindow(pt3min, pt3max)
'prRes.Status = ERROR
If (prRes.Status <> PromptStatus.OK) Then Return False
Dim objIds As ObjectIdCollection = New ObjectIdCollection()
Dim objIdArray() As ObjectId = prRes.Value.GetObjectIds()
For Each id As ObjectId In objIdArray
objIds.Add(id)
Next
Using newDb As Database = New Database(True, False)
VBCad.Application.LoadLinetype(newDb)
db.Wblock(newDb, objIds, Point3d.Origin, DuplicateRecordCloning.Ignore)
Using Tr As Transaction = newDb.TransactionManager.StartTransaction
Dim DsTbl As DimStyleTable = Tr.GetObject(newDb.DimStyleTableId, OpenMode.ForWrite)
Dim StyleName As String = ""
Using tr1 As Transaction = db.TransactionManager.StartTransaction
StyleName = TryCast(db.Dimstyle.GetObject(OpenMode.ForRead), DimStyleTableRecord).Name
End Using
If DsTbl.Has(StyleName) = False Then
If DsTbl.IsWriteEnabled = False Then DsTbl.UpgradeOpen()
Dim acDimStyleTblRec = New DimStyleTableRecord()
acDimStyleTblRec.Name = StyleName
DsTbl.Add(acDimStyleTblRec)
Tr.AddNewlyCreatedDBObject(acDimStyleTblRec, True)
db.WblockCloneObjects(db.GetDimRecentStyleList, newDb.DimStyleTableId, New IdMapping, DuplicateRecordCloning.Replace, False)
End If
Dim FileNameFont As String = ""
Using TrDb As Transaction = db.TransactionManager.StartTransaction
Dim TsTbl As TextStyleTable = TrDb.GetObject(db.TextStyleTableId, OpenMode.ForWrite)
If TsTbl.Has("Standard") = True Then
Dim acTextStyleTblRec As TextStyleTableRecord = TrDb.GetObject(TsTbl("Standard"), OpenMode.ForWrite)
FileNameFont = acTextStyleTblRec.FileName
Dim TextStyleCollection As New ObjectIdCollection
TextStyleCollection.Add(acTextStyleTblRec.ObjectId)
db.WblockCloneObjects(TextStyleCollection, newDb.TextStyleTableId, New IdMapping, DuplicateRecordCloning.Replace, False)
TrDb.Commit()
End If
End Using
If FileNameFont <> "" Then
Dim NewTsTbl As TextStyleTable = Tr.GetObject(newDb.TextStyleTableId, OpenMode.ForWrite)
Dim NewacTextStyleTblRec As TextStyleTableRecord = Tr.GetObject(NewTsTbl("Standard"), OpenMode.ForWrite)
NewacTextStyleTblRec.FileName = FileNameFont
End If
Dim obj As ObjectId = DsTbl(StyleName)
Dim DimTabbRecaord As DimStyleTableRecord = Tr.GetObject(obj, OpenMode.ForRead)
Dim CurrDb As Database = HostApplicationServices.WorkingDatabase
Dim Wpf As Integer = Autodesk.AutoCAD.ApplicationServices.Core.Application.GetSystemVariable("WIPEOUTFRAME")
HostApplicationServices.WorkingDatabase = newDb
Autodesk.AutoCAD.ApplicationServices.Core.Application.SetSystemVariable("WIPEOUTFRAME", Wpf)
HostApplicationServices.WorkingDatabase = CurrDb
newDb.SetDimstyleData(DimTabbRecaord)
newDb.Dimstyle = DimTabbRecaord.ObjectId
newDb.Ltscale = LtScale
newDb.Dimscale = DimScale
Dim vpt As ViewportTable = Tr.GetObject(newDb.ViewportTableId, OpenMode.ForRead)
Dim vptr As ViewportTableRecord = Tr.GetObject(vpt.Item("*Active"), OpenMode.ForWrite)
Dim pt2Max As Point2d = New Point2d(pt3max.X, pt3max.Y)
Dim pt2Min As Point2d = New Point2d(pt3min.X, pt3min.Y)
Dim scrSize As Point2d = ApplicationServices.Application.GetSystemVariable("screensize")
Dim ratio As Double = scrSize.X / scrSize.Y
Dim height As Double = pt2Max.Y - pt2Min.Y
Dim width As Double = pt2Max.X - pt2Min.X
If (width / height < ratio) Then
vptr.Height = height
vptr.Width = height * ratio
Else
vptr.Width = width
vptr.Height = width / ratio
End If
vptr.CenterPoint = pt2Min + (pt2Max - pt2Min) / 2.0
newDb.UpdateExt(True)
Tr.Commit()
End Using
Dim bmp As System.Drawing.Bitmap = ExtracThumbnail(newDb)
newDb.ThumbnailBitmap = bmp
Dim FileName As String = PathToExport
newDb.SaveAs(FileName, Version)
End Using
Return True
End Function
