I looked at the code in the link that blockbox suggested. I converted it to Vb.net but I am having problems with it.
I can figure out what ".Toupper" means in the code below. I know if I try to set blockName to blkname as a string
it causes and error a statement ar.UpgradeOpen(). I do not know what upgradeopen does.
Dim pr As PromptResult = ed.GetString(vbLf & "Enter name of block to search for: ")
'Dim pr As PromptResult = ed.GetString(vbLf & blkName & vbLf)
'Dim pr As PromptResult = bkname
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim blockName As String = pr.StringResult.ToUpper()
'blockName = blkName (blkName as a string) Here is my complete code in the box below. It is in form 2 with a textbox4 and a button click event.
Imports System
Imports System.IO
Imports System.Diagnostics
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Public Class Form2
Private blkName As String
Private idArray As ObjectId()
Private Property btrid As Database
Private blockname As String
Public Sub SelectForBlkName()
Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor
Dim db As Database = HostApplicationServices.WorkingDatabase
Dim tr As Transaction = db.TransactionManager.StartTransaction()
' Start the transaction
Try
' Build a filter list so that only
' block references are selected
Dim filList As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.Start), "INSERT")}
'Private filList As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.Start), "INSERT")}
Dim filter As New SelectionFilter(filList)
'Was inbetween Note 3 in public Shared
'Dim filList As TypedValue() = New TypedValue(0) {New TypedValue(CInt(DxfCode.Start), "INSERT")}
'Dim filter As New SelectionFilter(filList)
'was inbetween note 3 in public shared
Dim opts As New PromptSelectionOptions()
Dim dbObj As DBObject
Me.Hide()
opts.MessageForAdding = "Select block references: "
Dim res As PromptSelectionResult = ed.GetSelection(opts, filter)
'***Dim ent As Entity = acTrans.GetObject(acObjId, OpenMode.ForRead)
' Do nothing if selection is unsuccessful
If res.Status <> PromptStatus.OK Then
Return
End If
Dim selSet As SelectionSet = res.Value
'Dim res1 As PromptSelectionResult = ed.GetEntity
'Dim ent As Entity = tr.GetObject(acObjId, OpenMode.ForRead)
idArray = selSet.GetObjectIds()
For Each blkId As ObjectId In idArray
Dim blkRef As BlockReference = DirectCast(tr.GetObject(blkId, OpenMode.ForRead), BlockReference)
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(blkRef.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)
dbObj = tr.GetObject(blkId, OpenMode.ForRead)
'dbObj.
'TextBox4.Text = btr.Name
blkName = btr.Name
ed.WriteMessage(vbLf & "Block: " + btr.Name)
'MsgBox(btr.Name)
'For Each attId As ObjectId In btr
'For Each acObjId As ObjectId In acBlkTblRec
Dim ent As Entity = tr.GetObject(blkId, OpenMode.ForRead)
ed.WriteMessage(vbLf & "Layer: " & ent.Layer.ToString())
'Next
btr.Dispose()
'Dim attCol As AttributeCollection = blkRef.AttributeCollection
'For Each attId As ObjectId In attCol
'Dim attRef As AttributeReference = DirectCast(tr.GetObject(attId, OpenMode.ForRead), AttributeReference)
'Dim str As String = ((vbLf & " Attribute Tag: " + attRef.Tag & vbLf & " Attribute String: ") + attRef.TextString)
'ed.WriteMessage(str)
'Next
Next
tr.Commit()
Catch ex As System.Exception
'Catch ex As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(("Exception: " + ex.Message))
MsgBox("Selection Routine Exception: " + ex.Message)
tr.Dispose()
Exit Sub
Finally
tr.Dispose()
End Try
' ListAttributes()
'Me.Show()
'Returnvalue = blkName
End Sub
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
SelectForBlkName()
UpdateAttribute()
End Sub
Public Sub UpdateAttribute()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
' Have the user choose the block and attribute
' names, and the new attribute value
Dim pr As PromptResult = ed.GetString(vbLf & "Enter name of block to search for: ")
'Dim pr As PromptResult = ed.GetString(vbLf & blkName & vbLf)
'Dim pr As PromptResult = bkname
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim blockName As String = pr.StringResult.ToUpper()
'blockName = blkName (blkName as a string)
pr = ed.GetString(vbLf & "Enter tag of attribute to update: ")
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim attbName As String = pr.StringResult.ToUpper()
pr = ed.GetString(vbLf & "Enter new value for attribute: ")
If pr.Status <> PromptStatus.OK Then
Return
End If
Dim attbValue As String = pr.StringResult
UpdateAttributesInDatabase(db, blockName, attbName, attbValue)
End Sub
Private Sub UpdateAttributesInDatabase(db As Database, blockName As String, attbName As String, attbValue As String)
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
' Get the IDs of the spaces we want to process
' and simply call a function to process each
Dim msId As ObjectId, psId As ObjectId
Dim tr As Transaction = db.TransactionManager.StartTransaction()
Using tr
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
msId = bt(BlockTableRecord.ModelSpace)
psId = bt(BlockTableRecord.PaperSpace)
' Not needed, but quicker than aborting
tr.Commit()
End Using
Dim msCount As Integer = UpdateAttributesInBlock(msId, blockName, attbName, attbValue)
Dim psCount As Integer = UpdateAttributesInBlock(psId, blockName, attbName, attbValue)
ed.Regen()
' Display the results
ed.WriteMessage(vbLf & "Processing file: " & Convert.ToString(db.Filename))
ed.WriteMessage(vbLf & "Updated {0} instance{1} of " & "attribute {2} in the modelspace.", msCount, If(msCount = 1, "", "s"), attbName)
ed.WriteMessage(vbLf & "Updated {0} instance{1} of " & "attribute {2} in the default paperspace.", psCount, If(psCount = 1, "", "s"), attbName)
End Sub
Private Function UpdateAttributesInBlock(btrId As ObjectId, blockName As String, attbName As String, attbValue As String) As Integer
' Will return the number of attributes modified
Dim changedCount As Integer = 0
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(btrId, OpenMode.ForRead), BlockTableRecord)
' Test each entity in the container...
For Each entId As ObjectId In btr
Dim ent As Entity = TryCast(tr.GetObject(entId, OpenMode.ForRead), Entity)
If ent IsNot Nothing Then
Dim br As BlockReference = TryCast(ent, BlockReference)
If br IsNot Nothing Then
Dim bd As BlockTableRecord = DirectCast(tr.GetObject(br.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)
' ... to see whether it's a block with
' the name we're after
If bd.Name.ToUpper() = blockName Then
' Check each of the attributes...
For Each arId As ObjectId In br.AttributeCollection
Dim obj As DBObject = tr.GetObject(arId, OpenMode.ForRead)
Dim ar As AttributeReference = TryCast(obj, AttributeReference)
If ar IsNot Nothing Then
' ... to see whether it has
' the tag we're after
If ar.Tag.ToUpper() = attbName Then
' If so, update the value
' and increment the counter
ar.UpgradeOpen()
ar.TextString = attbValue
ar.DowngradeOpen()
changedCount += 1
End If
End If
Next
End If
' Recurse for nested blocks
changedCount += UpdateAttributesInBlock(br.BlockTableRecord, blockName, attbName, attbValue)
End If
End If
Next
tr.Commit()
End Using
Return changedCount
End Function
Private Sub Form2_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
End Sub
End Class
My problem with vb.net and Autocad is the I cannot find a place that tell how the statements are defined and used.
Any suggestions? ar.UpgradeOpen() is in the Function UpdateAttributesInBlock near the ending of the code.
Thank you,
