Try this:
Private Sub InsertAttibuteInBlockRef(ByVal blkRef As BlockReference, ByVal attributeTag As String, ByVal attributeText As String, ByVal tr As Transaction)
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkRef.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)
For Each attId As ObjectId In btr
Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
If TypeOf ent Is AttributeDefinition Then
Dim attDef As AttributeDefinition = DirectCast(ent, AttributeDefinition)
Dim attRef As New AttributeReference()
attRef.SetAttributeFromBlock(attDef, blkRef.BlockTransform)
If attRef.Tag = attributeTag Then
attRef.TextString = attributeText
Dim id As ObjectId = blkRef.AttributeCollection.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
Exit For
End If
End If
Next
End Sub
Public Sub BlkInsert(ByVal basePath As String, ByVal blkName As String, ByVal px As Point3d, ByVal theta As Double, ByVal sx As Double, ByVal Layer As String, ByVal side As String, ByVal AttValList As ArrayList, ByVal AttTagList As ArrayList)
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database
acCurDb = HostApplicationServices.WorkingDatabase()
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
If acBlkTbl.Has(blkName) Then
Dim blkObjId = acBlkTbl(blkName)
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim blkRef As BlockReference = New BlockReference(px, blkObjId)
blkRef.Rotation = theta
blkRef.ScaleFactors = New Scale3d(sx, sx, 1)
blkRef.Layer = Layer
acBlkTblRec.AppendEntity(blkRef)
acTrans.AddNewlyCreatedDBObject(blkRef, True)
Dim dPropsCollection As DynamicBlockReferencePropertyCollection
dPropsCollection = blkRef.DynamicBlockReferencePropertyCollection
For Each dprop As DynamicBlockReferenceProperty In dPropsCollection
If dprop.PropertyName = "Visibility1" Then
dprop.Value = side
End If
Next
Try
Dim i As Integer = 0
For Each tag As String In AttTagList
InsertAttibuteInBlockRef(blkRef, tag, AttValList(i).ToString, acTrans)
i = i + 1
Next
acBlkTblRec.UpdateAnonymousBlocks()
blkRef.RecordGraphicsModified(True)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Else
Dim blkFile As String = basePath + "\\" + blkName + ".dwg"
Dim blkObjId As ObjectId
Dim dbDwg As New Database(False, True)
dbDwg.ReadDwgFile(blkFile, IO.FileShare.Read, True, "")
blkObjId = acCurDb.Insert(blkName, dbDwg, True)
dbDwg.Dispose()
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
Dim blkRef As BlockReference = New BlockReference(px, blkObjId)
blkRef.Rotation = theta
blkRef.ScaleFactors = New Scale3d(sx, sx, 1)
blkRef.Layer = Layer
acBlkTblRec.AppendEntity(blkRef)
acTrans.AddNewlyCreatedDBObject(blkRef, True)
Dim dPropsCollection As DynamicBlockReferencePropertyCollection
dPropsCollection = blkRef.DynamicBlockReferencePropertyCollection
For Each dprop As DynamicBlockReferenceProperty In dPropsCollection
If dprop.PropertyName = "Visibility1" Then
dprop.Value = side
End If
Next
Dim i As Integer = 0
For Each tag As String In AttTagList
InsertAttibuteInBlockRef(blkRef, tag, AttValList(i).ToString, acTrans)
i = i + 1
Next
acBlkTblRec.UpdateAnonymousBlocks()
blkRef.RecordGraphicsModified(True)
End If
acTrans.Commit()
End Using
End Sub<CommandMethod("MBLKTEST")> _
Public Sub Blktest()
Dim TagList As New ArrayList
Dim ValList As New ArrayList
Dim side As String = "Top"
TagList.Add("TAG1")
TagList.Add("TAG2")
ValList.Add("VAL1")
ValList.Add("VAL2")
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim pr As PromptPointResult = ed.GetPoint("Pick a point:")
If pr.Status = PromptStatus.OK Then
Dim i As Integer = 0
Dim n As Integer = 10
Dim basePath As String = "C:\\MyBasePath"
Dim px As Point3d = pr.Value
For i = 0 To n
AlInsert(basePath, "MyBlockName", px, 0, 1, "0", side, ValList, TagList)
px = Polar(px, 3500, 0)
Next
End If
End SubPrivate Function Polar(ByVal bpoint As Point3d, ByVal r As Double, ByVal theta As Double) As Point3d
Dim px As New Point3d(bpoint.X + r * Math.Cos(theta), bpoint.Y + r * Math.Sin(theta), bpoint.Z)
Return px
End Function
You will need a dynamic block with 2 visibility states (the "side" parameter) and 2 attributes , or you can just get rid off that part of the code, and use a simple block with attributes.
Gaston Nunez
