TheSwamp
Code Red => .NET => Topic started by: huiz on August 13, 2010, 02:43:59 PM
-
I try to add blocks into AutoCAD with attributes and I am almost there! But it does weird things with annotative blocks.
The function is this:
Public Shared Function hzInsertBlock(ByVal pntInsert As Geometry.Point3d,
ByVal strBlockName As String,
ByVal dScale As Double,
ByVal strLayerName As String) As DatabaseServices.ObjectId
' TODO: Check block if is dynamic and do other things
Dim retVal As DatabaseServices.ObjectId = Nothing
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
' Get the current document editor
Dim ed As Editor = doc.Editor
' Get the current database
Using db As Database = HostApplicationServices.WorkingDatabase
' Get the current transaction
Dim tr As Transaction = db.TransactionManager.StartTransaction
' using transaction
Using tr
Try
' Open current space for write
Dim myBT As BlockTable = doc.Database.BlockTableId.GetObject(OpenMode.ForRead)
Dim myBTR As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
' Annotation Scales
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
' Insert Block
Dim myBlockDef As BlockTableRecord = myBT(strBlockName).GetObject(OpenMode.ForRead)
Dim myBlockRef As New DatabaseServices.BlockReference(pntInsert, myBT(strBlockName))
Dim obj As ObjectId = myBTR.AppendEntity(myBlockRef)
tr.AddNewlyCreatedDBObject(myBlockRef, True)
' Set Attribute Value
Dim myAttColl As DatabaseServices.AttributeCollection
Dim myEnt As DatabaseServices.Entity
Dim myBTREnum As BlockTableRecordEnumerator
myAttColl = myBlockRef.AttributeCollection
myBTREnum = myBlockDef.GetEnumerator
While myBTREnum.MoveNext
myEnt = myBTREnum.Current.GetObject(OpenMode.ForWrite)
If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then
Dim myAttDef As DatabaseServices.AttributeDefinition = myEnt
Dim myAttRef As New DatabaseServices.AttributeReference
myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
myAttColl.AppendAttribute(myAttRef)
tr.AddNewlyCreatedDBObject(myAttRef, True)
End If
End While
' Set Layer
myBlockRef.Layer = strLayerName
' Set Scale
myBlockRef.ScaleFactors = New Geometry.Scale3d(dScale, dScale, dScale)
' Set Current Annotative Scale if block is Annotative
If myBlockRef.Annotative = AnnotativeStates.True Then
Dim AnnoObj As DBObject = tr.GetObject(obj, OpenMode.ForRead)
Internal.ObjectContexts.AddContext(AnnoObj, occ.CurrentContext)
End If
' Set return value
retVal = myBlockRef.ObjectId
' Commit transaction
tr.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Error: {0}" & vbLf & "Stack trace: {1}", ex.Message, ex.StackTrace)
End Try
End Using ' dispose transaction
End Using ' dispose database
' return
Return retVal
End Function
For filling the attributes I have a different function. Above is the function that will place a block and takes the attributes from the definition and adds it to the reference. There are two problems. One problem is that the attribute is always the size of the original, even while I add the current scale 1:500 or 1:250 to the block, the other problem is that the first placed block has the attribute at the right position, all others will have the attributes one textline lower. See image.
The red one is the only correct one.
-
Looking at the code real quick I can tell where you got some of it from. You can learn some stuff from that book, but pay attention to how the guys or girls on the site write their code. Alot of the stuff from that book seems like he just tries different things intellisense pops up until something works.
I am about to starve to death, but I will post after I get back from lunch.
-
A portion of the function comes from Jerry Winters. There are not many books about VB.NET and AutoCAD so it is a good point to start from. Though it is very simple and straight to the point, I realise it is not very helpful when I want more complex stuff. And that is the reason I read and post on The Swamp, to learn :-)
I tried a lot with this code but I keep getting these problems. I hope someone will find out why.
-
I was trying to keep his name out of it, but what do you learn from 4 sentences then 10 pages of code with 2 or 3 lines changed.
I would rather have 10 pages of good explanation and a couple pages of code.
I do not know how some of these guys have picked up all of their knowledge, but I know I have a tough time trying find resources to get a good understanding of the API.
-
Are these blocks you created that you inserting
-
The block I use is annotative. It is just one circle with one attribute.
-
See if this helps at all
<CommandMethod("InsertBlockWithAttributes")> _
Public Sub InsertBlockWithAttributes()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
Dim btrMS As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
''''''Check to see if blocktablerecods exists if not exits
''''' and if does opens models space for write'''''''
If Not bt.Has("C") Then
Exit Sub
Else
btrMS.UpgradeOpen()
End If
Dim btr As BlockTableRecord = bt("C").GetObject(OpenMode.ForRead)
'''' Creating an instance to produce random Numbers'''''
Dim randomNumber As New Random
'''''''Numbers between 5 and 100'''''''
Dim x As Double = randomNumber.Next(5, 100)
Dim y As Double = randomNumber.Next(5, 100)
Dim bref As New BlockReference(New Point3d(x, y, 0), btr.ObjectId)
btrMS.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
For Each objId As ObjectId In btr
Dim ent As Entity = objId.GetObject(OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
''''''Random Number Less than 100''''
attRef.TextString = randomNumber.Next(100).ToString
bref.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
End If
Next
tr.Commit()
End Using
End Sub
-
Could post a drawing with block
-
Drawing attached with one annotative block.
-
Perhaps it will helps:
myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
[color=red]myAttRef.AdjustAlignment(db)[/color]
myAttColl.AppendAttribute(myAttRef)
tr.AddNewlyCreatedDBObject(myAttRef, True)
And also use foreach instead of Enumerator
~'J'~
-
All i did was change the name of the block in the code and the circle was not showing up until you change annotation scale because of the ANNOAUTOSCALE
So I added code to fix that I will see if someone else will explain it because I am not sure I fully understand that part yet.
By the way you can type "ins" then hit tab a couple of times and the command will pop up
If you did not know the tab button goes through all comands alphabetically so netload just type "ne" tab
Also add Imports Autodesk.AutoCAD.Internal
<CommandMethod("InsertBlockWithAttributes")> _
Public Sub InsertBlockWithAttributes()
Dim db As Database = HostApplicationServices.WorkingDatabase
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
Dim btrMS As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
If Not bt.Has("exampleblock") Then
Exit Sub
Else
btrMS.UpgradeOpen()
End If
Dim btr As BlockTableRecord = bt("exampleblock").GetObject(OpenMode.ForRead)
Dim randomNumber As New Random
Dim x As Double = randomNumber.Next(5, 100)
Dim y As Double = randomNumber.Next(5, 100)
Dim bref As New BlockReference(New Point3d(x, y, 0), btr.ObjectId)
btrMS.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
If btr.Annotative = AnnotativeStates.True Then
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ObjectContexts.AddContext(bref, occ.CurrentContext)
End If
For Each objId As ObjectId In btr
Dim ent As Entity = objId.GetObject(OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
ent.UpgradeOpen()
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
attRef.TextString = randomNumber.Next(100).ToString
bref.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
End If
Next
tr.Commit()
End Using
End Sub
-
Did that help at all?
-
Did that help at all?
I just started to check this out (it took a while before the kids are going to bed, or sleep, whatever comes first :-) )
Your first solution is not working for annotative blocks. My function is working however the attributes won't follow the annotative scale of the block.
The solution of fixo did not do the trick, it is working code but it doesn't affect my function good or bad. Meanwhile I found the solution of the lowered attributes, accidentally there was a linefeed character in the value, so AutoCAD showed the text on the second line and on the first line there was a carriage return and line feed. Btw, maybe a cool trick to write multiline attributes without having Mtext :-)
But... there is still the problem that the attribute won't scale down or up with the block...
-
As suggested I tried to use ForEach instead of Getenumerator and the code is as follows:
Public Shared Function hzInsertBlock(ByVal pntInsert As Geometry.Point3d,
ByVal strBlockName As String,
ByVal dScale As Double,
ByVal strLayerName As String) As DatabaseServices.ObjectId
' TODO: Check block if is dynamic and do other things
Dim retVal As DatabaseServices.ObjectId = Nothing
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
' Get the current document editor
Dim ed As Editor = doc.Editor
' Get the current database
Using db As Database = HostApplicationServices.WorkingDatabase
' Get the current transaction
Dim tr As Transaction = db.TransactionManager.StartTransaction
' using transaction
Using tr
Try
' Open current space for write
Dim myBT As BlockTable = doc.Database.BlockTableId.GetObject(OpenMode.ForRead)
Dim myBTR As BlockTableRecord = CType(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
' Annotation Scales
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
' Insert Block
Dim myBlockDef As BlockTableRecord = myBT(strBlockName).GetObject(OpenMode.ForRead)
Dim myBlockRef As New DatabaseServices.BlockReference(pntInsert, myBT(strBlockName))
Dim obj As ObjectId = myBTR.AppendEntity(myBlockRef)
tr.AddNewlyCreatedDBObject(myBlockRef, True)
' Set Attribute Value
'Dim myAttColl As DatabaseServices.AttributeCollection
'Dim myEnt As DatabaseServices.Entity
'Dim myBTREnum As BlockTableRecordEnumerator
'myAttColl = myBlockRef.AttributeCollection
'myBTREnum = myBlockDef.GetEnumerator
'While myBTREnum.MoveNext
' myEnt = myBTREnum.Current.GetObject(OpenMode.ForWrite)
' If TypeOf myEnt Is DatabaseServices.AttributeDefinition Then
' Dim myAttDef As DatabaseServices.AttributeDefinition = myEnt
' Dim myAttRef As New DatabaseServices.AttributeReference
' myAttRef.SetAttributeFromBlock(myAttDef, myBlockRef.BlockTransform)
' myAttColl.AppendAttribute(myAttRef)
' tr.AddNewlyCreatedDBObject(myAttRef, True)
' End If
'End While
For Each objId As ObjectId In myBTR
Dim ent As Entity = objId.GetObject(OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
ent.UpgradeOpen()
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, myBlockRef.BlockTransform)
myBlockRef.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
End If
Next
' Set Layer
myBlockRef.Layer = strLayerName
' Set Current Annotative Scale if block is Annotative
If myBlockRef.Annotative = AnnotativeStates.True Then
Dim AnnoObj As DBObject = tr.GetObject(obj, OpenMode.ForRead)
Internal.ObjectContexts.AddContext(AnnoObj, occ.CurrentContext)
End If
' Set Scale
myBlockRef.ScaleFactors = New Geometry.Scale3d(dScale, dScale, dScale)
' Set return value
retVal = myBlockRef.ObjectId
' Commit transaction
tr.Commit()
Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage("Error: {0}" & vbLf & "Stack trace: {1}", ex.Message, ex.StackTrace)
End Try
End Using ' dispose transaction
End Using ' dispose database
' return
Return retVal
End Function
But now I don't get any attribute assigned to the block :-(
-
All i did was change the name of the block in the code and the circle was not showing up until you change annotation scale because of the ANNOAUTOSCALE
So I added code to fix that I will see if someone else will explain it because I am not sure I fully understand that part yet.
By the way you can type "ins" then hit tab a couple of times and the command will pop up
If you did not know the tab button goes through all comands alphabetically so netload just type "ne" tab
Also add Imports Autodesk.AutoCAD.Internal
Your sub is working well, I'll put it together with what I have now, and I hope to get a working function. But still I hope someone can explain why in my code the attributes won't scale.
-
For filling the attributes I have a different function
That is where problem might be
-
That is where problem might be
I'm not sure. The attributes are defined in my function, in a second one they are filled with text (just a loop, add textstring, nothing special). So the attribute gets defined at original size (I mean the designed size in the block definition with size 1 and Annotation Scale 1:1), even while the block gets an annotative scale. I've tested it also with a scalefactor, the block is scaled with a schale factor and the annotation scale, the attribute still gets the original size. I also tested with adding an empty textstring to the attribute but that doesn't do the trick.
Further I'm very confused why I don't get any attribute if I replace the part where I use Enumerator by your code with Foreach, but if I test your Sub without modification (and thus the same code to add attributes), I do get attributes and they nicely get scaled!
-
For Each objId As ObjectId In myBTR
Change to
For Each objId As ObjectId In myBlockDef
-
Did you define the block in a drawing with same settings as the Test.dwg you posted because your units are set to meters so 1:1 is 1 paper unit is equal to .001 drawing units
-
Did you define the block in a drawing with same settings as the Test.dwg you posted because your units are set to meters so 1:1 is 1 paper unit is equal to .001 drawing units
Sorry, I mean Annotation Scale 1:1000 (1 paper unit is 1 model unit). We use meters as standard.
Tomorrow I'll continue with my search. Probably something very simple so fix...
-
You were searching through modelspace with the previous code or current space
-
Well thanks to fro2001 I got a working sub that places a block, fills attributes and manages the annotative scale! :lol:
It is weird that if I turn it into a function, it does do nothing, if I call the procedure, it does work!
Final code:
' This procedure will insert a block into the current drawing. It also controls the defined attributes and it will
' add the current Annotation Scale if the block is Annotative.
' Code contribution:
' - fro2001 - via TheSwamp.org
Public Sub hzInsertBlockMSWithAttributes(ByVal pntInsert As Geometry.Point3d,
ByVal strBlockName As String,
ByVal dScale As Double,
ByVal strLayerName As String,
ByVal arrAttrValues As ArrayList)
Dim db As Database = HostApplicationServices.WorkingDatabase
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim bt As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead)
Dim btrMS As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForRead)
If Not bt.Has(strBlockName) Then
Exit Sub
Else
btrMS.UpgradeOpen()
End If
Dim btr As BlockTableRecord = bt(strBlockName).GetObject(OpenMode.ForRead)
Dim bref As New BlockReference(pntInsert, btr.ObjectId)
btrMS.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
' set annotation scale if block is annotative
If btr.Annotative = AnnotativeStates.True Then
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
Internal.ObjectContexts.AddContext(bref, occ.CurrentContext)
End If
' set attributes and values
' TODO: Set attribute to layer of block or layer of original definition, now it will be placed on layer 0
' TODO: Check if attribute is annotative, it is possible to create non-annotative blocks with annotative attributes
Dim ccAttCounter As Integer = 0
For Each objId As ObjectId In btr
Dim ent As Entity = objId.GetObject(OpenMode.ForRead)
If TypeOf ent Is AttributeDefinition Then
ent.UpgradeOpen()
Dim attDef As AttributeDefinition = CType(ent, AttributeDefinition)
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
' check if there is a value to add
If arrAttrValues.Count - 1 >= ccAttCounter Then
attRef.TextString = arrAttrValues(ccAttCounter).ToString.Trim
Else
attRef.TextString = ""
End If
bref.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
ccAttCounter += 1
End If
Next
' set layer
' TODO: Check if layername exist
bref.Layer = strLayerName
' commit
tr.Commit()
End Using
End Sub
Now I can move on with the tool I am developing, a global import routine from Excel (or basically any delimetered data from the Clipboard). It will place the data in colums (no matter how many) in a datagrid, then you choose the X and Y and Point ID, check the layer and if other data has to be placed as text, and then all the data will be exported as blocks or text.
See screenshot.