I'm trying to read objects on a specific layout in an external drawing.
Reading the external drawing is not a problem when the objects are in "*Modelspace".
But finding the specific layoutid and throwing that in an Blocktabelrecord is.
I hope someone has an idea to do this..
Here is the code.
Dim NaamDwg = "C:\Program Files\Autodesk\AutoCAD 2011\Sample\Database Connectivity\db_samp.dwg"
Dim strLaagNaam = "FURNITURE"
Try
'' **** Contact maken met externe tekening ****
Dim Xdwg = New Database(False, True)
Dim Xtransman As Autodesk.AutoCAD.DatabaseServices.TransactionManager = Xdwg.TransactionManager
'' *** Contact maken met huidige tekening ****
Dim doc = Application.DocumentManager.MdiActiveDocument
Dim dwg = doc.Database
Dim Transman As Autodesk.AutoCAD.DatabaseServices.TransactionManager = dwg.TransactionManager
'' **** Lees externe tekening ****
Xdwg.ReadDwgFile(NaamDwg, IO.FileShare.Read,True, "")
'' **** Start transacties
Dim XTransactie As Autodesk.AutoCAD.DatabaseServices.Transaction = Xtransman.StartTransaction()
Dim transactie As Autodesk.AutoCAD.DatabaseServices.Transaction = Transman.StartTransaction
'' *** Open huidige tekenin blocktable en modelspace tablerecord als schrijven ****
Dim blocktbl As BlockTable = dwg.BlockTableId.GetObject(OpenMode.ForWrite)
Dim blocktblrec As BlockTableRecord = blocktbl(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite)
'' *** Open externe blocktable en modelspace blocktablerecord als alleen-lezen****
Dim XBlocktbl As BlockTable = XTransactie.GetObject(Xdwg.BlockTableId, OpenMode.ForRead)
Dim Xblocktbrec As BlockTableRecord = XTransactie.GetObject(XBlocktbl("Layout1"), OpenMode.ForRead)
'' **** Doorloop alle entities in de externe tekening ****
ForEach XObjectid In Xblocktbrec
Dim Xentiteit As Entity = XTransactie.GetObject(XObjectid, OpenMode.ForRead)
'**** Kijken of de entiteit op de juiste laag staat ****
If Xentiteit.Layer = strLaagNaam Then
Dim Map AsNew Autodesk.AutoCAD.DatabaseServices.IdMapping
Dim EntVerz AsNew ObjectIdCollection
EntVerz.Add(Xentiteit.ObjectId)
dwg.WblockCloneObjects(EntVerz, blocktblrec.ObjectId, Map, DuplicateRecordCloning.Replace, False)
End If
Next
transactie.Commit()
transactie.Dispose()
Transman.Dispose()
XTransactie.Dispose()
Xtransman.Dispose()
Xdwg.CloseInput(True)
Xdwg.Dispose()
Catch ex As Exception
MsgBox("Something went wrong " & vbCrLf & ex.Message)
EndTry
Solved! Go to Solution.
Solved by nijhuis. Go to Solution.
Here's a way to go through all the layouts in a file(you may have to change some of the read/write parameters on the ReadDwgFile and GetObject calls.
Remember that model space is also a layout.
Dim db As Database
db = New Database(False, True)
db.ReadDwgFile(filename, System.IO.FileShare.Read, False, "")
Dim tr As Transaction = db.TransactionManager.StartTransaction
Using tr
Dim BT As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead) Dim BTR As BlockTableRecord = BT(Autodesk.AutoCAD.DatabaseServices.BlockTableRecord.ModelSpace).GetObject(Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead)
For Each btrId As ObjectId In BT BTR = tr.GetObject(btrId, OpenMode.ForRead) If BTR.IsLayout Then 'do something here in the layout
End If Next End Using
Here is my 2 c
Public Sub LoopLayouts() Dim filename As String = "C:\\Temp\\Test.dwg" Dim layts As New List(Of String) Dim doc As Document = acApp.DocumentManager.MdiActiveDocument Using Loc As DocumentLock = doc.LockDocument Dim ed As Editor = doc.Editor Try Using db As Database = New Database(False, True) db.ReadDwgFile(filename, System.IO.FileShare.ReadWrite, False, "") Dim tr As Transaction = db.TransactionManager.StartTransaction Using tr Dim ldict As DBDictionary = tr.GetObject(db.LayoutDictionaryId, OpenMode.ForRead) For Each dicent As DBDictionaryEntry In ldict Dim lay As Layout = CType(dicent.Value.GetObject(OpenMode.ForRead), Layout) layts.Add(lay.LayoutName) ''<-- collect names to list of strings ''do your stuffs in the every layout, e.g. draw circle: Dim btr As BlockTableRecord = tr.GetObject(lay.BlockTableRecordId, OpenMode.ForWrite) Dim circ As Circle = New Circle(New Point3d(0, 0, 0), New Vector3d(0, 0, 1), 12.345) btr.AppendEntity(circ) tr.AddNewlyCreatedDBObject(circ, True) Next db.SaveAs(filename, False, DwgVersion.Newest, db.SecurityParameters) '<-- might be a different syntax here db.CloseInput(True) tr.Commit() End Using End Using Catch ex As System.Exception acApp.ShowAlertDialog(Environment.NewLine + ex.Message + Environment.NewLine + ex.StackTrace) End Try For Each lname As String In layts ed.WriteMessage(Environment.NewLine + lname) Next End Using End Sub