Hi all,
I am trying to write a function to insert a block reference of a block definition which is already stored in the same drawing.
All threads are leads me to the way of inserting another drawing to current drawing with use of database.readdwgfile & database.insert.
Kindly share how to use those methods for a block definition stored in the same drawing.
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Windows Imports Autodesk.AutoCAD.LayerManager.LayerFilter Imports Autodesk.AutoCAD.EditorInput Imports System.IO Imports Autodesk.AutoCAD.Geometry Public Class Class1 ' Define command 'Asdkcmd1' <CommandMethod("ImpBloc")> _ Public Sub ImpBloc() 'implanter un bloc Bp 'imp the bloc Dim DB As Database = HostApplicationServices.WorkingDatabase Dim ed As Editor ed = Application.DocumentManager.MdiActiveDocument.Editor Dim trans As Transaction trans = DB.TransactionManager.StartTransaction 'récupération de la table des block 'rep the block def. Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead) Dim btr As BlockTableRecord btr = trans.GetObject(bt.Item(BlockTableRecord.ModelSpace), OpenMode.ForWrite) Dim id As ObjectId If bt.Has("bp") Then 'found in the base Dim btrSrc As BlockTableRecord btrsrc=trans.GetObject(bt.Item("BP"), OpenMode.ForRead) id = btrSrc.Id Else 'not found --> load the dwg Dim Dbdwg As New Database(False, True) Dbdwg.ReadDwgFile("d:\autocad\bloc.dwg\bp.dwg", FileOpenMode.OpenTryForReadShare, True, "") id = DB.Insert("bp", Dbdwg, False) Dbdwg.Dispose() End If ' 'insertion : Dim opPt As New PromptPointOptions("Sélect a point") Dim resPt As PromptPointResult resPt = ed.GetPoint(opPt) Dim ptInsert As Point3d = Nothing Dim blkRef As BlockReference If resPt.Status = PromptStatus.OK Then ptInsert = resPt.Value blkRef = New BlockReference(ptInsert, id) btr.AppendEntity(blkRef) trans.AddNewlyCreatedDBObject(blkRef, True) ' modify the attribute of the block reference Dim btAttRec As BlockTableRecord btAttRec = trans.GetObject(id, OpenMode.ForRead) Dim idAtt As ObjectId For Each idAtt In btAttRec Dim ent As Entity ent = trans.GetObject(idAtt, OpenMode.ForRead) If TypeOf ent Is AttributeDefinition Then Dim attDef As AttributeDefinition attDef = CType(ent, AttributeDefinition) Dim attRef As New AttributeReference() attRef.SetAttributeFromBlock(attDef, blkRef.BlockTransform) 'Dim ptBase As New Point3d(blkRef.Position.X + attDef.Position.X, blkRef.Position.Y + attDef.Position.Y, blkRef.Position.Z + attDef.Position.Z) 'attRef.Position = ptBase 'attRef.Rotation = attDef.Rotation 'attRef.Tag = attDef.Tag attRef.TextString = "input your data here" 'attRef.Height = attDef.Height 'attRef.FieldLength = attDef.FieldLength Dim idTmp As ObjectId idTmp = blkRef.AttributeCollection.AppendAttribute(attRef) trans.AddNewlyCreatedDBObject(attRef, True) End If Next trans.Commit() Else MsgBox("Point introuvable !") trans.Abort() End If End Sub end class
here a example for insert a block and fill the attribut
if the block is know in the base --> insert but if not the vb.net load a file bp.dwg
Try this code for the same drawing
Public Sub ApplyAttributes(db As Database, tr As Transaction, bref As BlockReference) Dim btrec As BlockTableRecord = TryCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord) If btrec.HasAttributeDefinitions Then Dim atcoll As Autodesk.AutoCAD.DatabaseServices.AttributeCollection = bref.AttributeCollection For Each subid As ObjectId In btrec Dim ent As Entity = DirectCast(subid.GetObject(OpenMode.ForRead), Entity) Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition) If attDef IsNot Nothing Then Dim attRef As New AttributeReference() attRef.SetDatabaseDefaults() attRef.SetAttributeFromBlock(attDef, bref.BlockTransform) attRef.Position = attDef.Position.TransformBy(bref.BlockTransform) attRef.Tag = attDef.Tag attRef.TextString = attDef.TextString attRef.AdjustAlignment(db) atcoll.AppendAttribute(attRef) tr.AddNewlyCreatedDBObject(attRef, True) End If Next End If End Sub Public Sub TestInsert() Dim blkname As String = "MYBLOCK" ''<-- change to your needs Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim ed As Editor = doc.Editor Dim db As Database = doc.Database Try Using docloc As DocumentLock = doc.LockDocument Using tr As Transaction = db.TransactionManager.StartTransaction Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead) If Not bt.Has(blkname) Then MsgBox("Block does not exists") Return End If Dim pto As PromptPointOptions = New PromptPointOptions(vbLf + "Pick a block insertion point: ") Dim ptres As PromptPointResult = ed.GetPoint(pto) Dim ipt As Point3d If ptres.Status <> PromptStatus.Cancel Then ipt = ptres.Value End If Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord) Dim blk As BlockTableRecord = DirectCast(tr.GetObject(bt(blkname), OpenMode.ForRead, False), BlockTableRecord) Dim bref As New BlockReference(ipt, blk.ObjectId) bref.BlockUnit = UnitsValue.Millimeters''<-- change to your needs bref.Rotation = 0 bref.ScaleFactors = New Scale3d(1.0) ''<-- change to your needs btr.AppendEntity(bref) tr.AddNewlyCreatedDBObject(bref, True) ApplyAttributes(db, tr, bref) ed.Regen() tr.Commit() End Using End Using Catch ex As System.Exception MsgBox(ex.Message) End Try End Sub
~'J'~
Both answers my question. Thank you very much for your valuable time spend on this.
Now slowly i am learning dotnet .While i need one clarification on Hallex code.
Why you use "Directcast" on below lines?. If the question make any sense kindly answer.
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord) Dim blk As BlockTableRecord = DirectCast(tr.GetObject(bt(blkname), OpenMode.ForRead, False), BlockTableRecord)
Here is an excerpt from MSDN docs:Remarks
DirectCast does not use the Visual Basic run-time helper routines for conversion, so it can provide somewhat better performance than CType when converting to and from data type Object.
You use the DirectCast keyword similar to the way you use the CType Function (Visual Basic) and the TryCast Operator (Visual Basic) keyword. You supply an expression as the first argument and a type to convert it to as the second argument. DirectCast requires an inheritance or implementation relationship between the data types of the two arguments. This means that one type must inherit from or implement the other.
Errors and FailuresDirectCast generates a compiler error if it detects that no inheritance or implementation relationship exists. But the lack of a compiler error does not guarantee a successful conversion. If the desired conversion is narrowing, it could fail at run time. If this happens, the runtime throws an InvalidCastException error.
Hope it make a sense,
Cheers 🙂
~'J'~
Today i learned some more things.
Thank you very much for your reply.
Glad I could help,
Happy coding 🙂
~'J'~
Can't find what you're looking for? Ask the community or share your knowledge.