Hi, this part of my code is supposed to look for a layout I just added, search through it's blocks that have attributes, and if the block with the specific attributes is found, it should open a dialog box and populate the two text boxes with the attribute text. When the user changes the text in the dialog box and picks ok, I want it to go back and change the attribute values in the block.
I'm just not sure how to change the text value for the attributes. Do I create an identical code that will search all over again only to write the values instad of read? There has to be an easier way since I have the block located already.
Public Sub replaceTitleText(ByVal pageNumber As Integer) Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim layoutCount As Integer = LayoutManager.Current.LayoutCount - 1 Dim getTexttrans As Transaction = db.TransactionManager.StartTransaction() Try Dim myBT As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead) For Each btrID As ObjectId In myBT Dim myBTR As BlockTableRecord = btrID.GetObject(OpenMode.ForRead) ' If the block table record is a layout If myBTR.IsLayout Then Dim layOut As Layout = myBTR.LayoutId.GetObject(OpenMode.ForRead) ' If the layout is the new layout If layOut.TabOrder = pageNumber Then For Each id As ObjectId In myBTR Dim obj As DBObject = id.GetObject(OpenMode.ForRead) ' If the object is a block reference If TypeOf obj Is BlockReference Then Dim bref As BlockReference = DirectCast(obj, BlockReference) ' If the block reference has attributes If bref.AttributeCollection.Count <> 0 Then For Each attId As ObjectId In bref.AttributeCollection Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead) ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute ' get the current text values for the attributes Dim textTitle As String = "" Dim textDieSide As String = "" If attRef.Tag = "PAGE_TITLE" Then textTitle = attRef.TextString End If If attRef.Tag = "DIE_SIDE_VIEW" Then textDieSide = attRef.TextString 'diaTitleText.txtDieSide.Visible = True End If ' If the block has either one of these attributes If Not textTitle = "" Or Not textDieSide = "" Then Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide) 'diaTitleText.ShowDialog() If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then textTitle = diaTitleText.newTextTitle textDieSide = diaTitleText.newTextDieSide End If End If Next End If End If Next End If End If Next Catch ed.WriteMessage("Error!") Finally getTexttrans.Commit() End Try End Sub
Solved! Go to Solution.
Solved by Alfred.NESWADBA. Go to Solution.
Hi,
>> Do I create an identical code that will search all over again only to write the values instad of read?
No, you could save the ObjectID of the AttributeReference and reopen it (writeable) when finished with the dialog and the values changed.
For Each attId As ObjectId In bref.AttributeCollection Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead) ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute ' get the current text values for the attributes Dim textTitle As String = "" Dim textDieSide As String = "" 'CHANGE 1: prepare variables for the ObjectID of the AttRefs Dim textTitleAttRefID as ObjectID Dim textDieSideAttRefID as ObjectID 'CHANGE 1 end If attRef.Tag = "PAGE_TITLE" Then textTitle = attRef.TextString textTitleAttRefID = attRef.ObjectID 'CHANGE 2 save the ObjectID End If If attRef.Tag = "DIE_SIDE_VIEW" Then textDieSide = attRef.TextString 'diaTitleText.txtDieSide.Visible = True textDieSideAttRefID = attRef.ObjectID 'CHANGE 3: save the ObjectID End If ' If the block has either one of these attributes If Not textTitle = "" Or Not textDieSide = "" Then Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide) 'diaTitleText.ShowDialog() If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then 'CHANGE 4: open the AttRef's for write and save the new textvalues if textTitle <> diaTitleText.newTextTitle Then 'only overwrite when value has changed textTitle = diaTitleText.newTextTitle if textTitleAttRefID.isValid Then 'check if the AttRef exists (seems as it does not have to exist) Dim tAttRefWRITE as AttributeReference = ctype(getTexttrans.GetObject(textTitleAttRefID,OpenMode.ForWrite),AttributeReference) tAttRefWRITE.TextString = textTitle end if end if if textDieSide <> diaTitleText.newTextDieSideThen 'only overwrite when value has changed textDieSide = diaTitleText.newTextDieSideThen if textDieSideAttRefID.isValid Then 'check if the AttRef exists (seems as it does not have to exist) Dim tAttRefWRITE as AttributeReference = ctype(getTexttrans.GetObject(textDieSideAttRefID, OpenMode.ForWrite),AttributeReference) tAttRefWRITE.TextString = textDieSideAttRefID end if end if 'CHANGE 5: you can remove this as it is built in CHANGE 4 'textTitle = diaTitleText.newTextTitle 'textDieSide = diaTitleText.newTextDieSide End If End If Next
Hope I have not overlooked something.
One more input to your code:
You set the .Commit for the transaction within the Finally-Statement (of the Try-Catch).
What does that mean? Finally runs after Catch, so it will also run if the code crashed somewhere within the Try-section. IMHO that does not make sense to .Commit the transaction even not knowing if the code run clean or failed. I would prefere to set the .Commit-statement in the Try-section/last code-line before Catch. So I know if this code-line is reached there was no error so far.
And there is a second problem you can solve with my version: Sometimes the .Commit itself throws an exception, every time it should commit something where object-creations or database-modifications where not prepared well. And for this exception you are out of a Try- and not before a Catch-section! That means this exception will throw up to the next/hierarchically above Catch ... if you have one ... if not AutoCAD crashes!
Hope my description is understandable and helps, good luck, - alfred -
Hi Alfred,
Thank you very much for your help. I did what you suggested and after a few tweaks of my own, the code works great!
Public Sub replaceTitleText(ByVal pageNumber As Integer) Dim doc As Document = Application.DocumentManager.MdiActiveDocument Dim db As Database = doc.Database Dim ed As Editor = doc.Editor Dim layoutCount As Integer = LayoutManager.Current.LayoutCount - 1 Dim textTitle As String = "" Dim textDieSide As String = "" Dim getTexttrans As Transaction = db.TransactionManager.StartTransaction() Try Dim myBT As BlockTable = db.BlockTableId.GetObject(OpenMode.ForRead) For Each btrID As ObjectId In myBT Dim myBTR As BlockTableRecord = btrID.GetObject(OpenMode.ForRead) ' If the block table record is a layout If myBTR.IsLayout Then Dim layOut As Layout = myBTR.LayoutId.GetObject(OpenMode.ForRead) ' If the layout is the new layout If layOut.TabOrder = pageNumber Then For Each id As ObjectId In myBTR Dim obj As DBObject = id.GetObject(OpenMode.ForRead) ' If the object is a block reference If TypeOf obj Is BlockReference Then Dim bref As BlockReference = DirectCast(obj, BlockReference) ' If the block reference has attributes Dim attCounter As Integer = 1 If bref.AttributeCollection.Count <> 0 Then For Each attId As ObjectId In bref.AttributeCollection Dim attRef As AttributeReference = attId.GetObject(OpenMode.ForRead) ' If the title block has the "PAGE_TITLE" or "DIE_SIDE_VIEW" attribute ' get the current text values for the attributes Dim textTitleAttRefID As ObjectId Dim textDieSideAttRefID As ObjectId If attRef.Tag = "PAGE_TITLE" Then textTitle = attRef.TextString textTitleAttRefID = attRef.ObjectId End If If attRef.Tag = "DIE_SIDE_VIEW" Then textDieSide = attRef.TextString textDieSideAttRefID = attRef.ObjectId End If ' If all of the attributes in the block have been checked If attCounter = bref.AttributeCollection.Count Then Dim diaTitleText As dialogTitleText = New dialogTitleText(textTitle, textDieSide) If diaTitleText.ShowDialog = System.Windows.Forms.DialogResult.OK Then ' Open the AttRef's for write and save the new textvalues If textTitle <> diaTitleText.txtSheetTitle.Text Then ' Only overwrite when value has changed textTitle = diaTitleText.txtSheetTitle.Text If textTitleAttRefID.IsValid Then 'check if the AttRef exists Dim tAttRefWRITE As AttributeReference = CType(getTexttrans.GetObject(textTitleAttRefID, OpenMode.ForWrite), AttributeReference) tAttRefWRITE.TextString = textTitle End If End If If Not textDieSide = "" Then If textDieSide <> diaTitleText.txtDieSide.Text Then ' Only overwrite when value has changed textDieSide = diaTitleText.txtDieSide.Text If textDieSideAttRefID.IsValid Then 'check if the AttRef exists Dim tAttRefWRITE As AttributeReference = CType(getTexttrans.GetObject(textDieSideAttRefID, OpenMode.ForWrite), AttributeReference) tAttRefWRITE.TextString = textDieSide End If End If End If End If End If attCounter += 1 Next End If End If Next End If End If Next Catch ed.WriteMessage("Error!") Finally getTexttrans.Commit() End Try End Sub
Again, thanks a lot.
Mark
Hi I had a smimilar requirement, but a little change, I would like to read the contents of the Titleblock and write it down to xl file, but the block is there in the model space, so here is what I have done, please suggest me that is there any other way so that I can improvise this code. thanks in advance
Public Sub ReadData(ByVal fName As String)
Dim acdoc As Document = Application.DocumentManager.Open(fName, False, Nothing)
acdoc = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acdoc.Database
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Using mydoclock As DocumentLock = acdoc.LockDocument()
Try
Dim acBlkTbl As BlockTable = acCurDb.BlockTableId.GetObject(OpenMode.ForRead)
For Each acOjbid As ObjectId In acBlkTbl
Dim acBlkTblRec As BlockTableRecord = acOjbid.GetObject(OpenMode.ForRead)
For Each accObjId As ObjectId In acBlkTblRec
Dim acObj As DBObject = accObjId.GetObject(OpenMode.ForRead)
If TypeOf acObj Is BlockReference Then
Dim acBlkRef As BlockReference = DirectCast(acObj, BlockReference)
Dim acAttCount As Integer = 1
If acBlkRef.AttributeCollection.Count <> 0 Then
For Each acAttId As ObjectId In acBlkRef.AttributeCollection
Dim acAttRef As AttributeReference = acAttId.GetObject(OpenMode.ForRead)
Dim macNum As String = ""
Dim drgName As String = ""
Dim drgNum As String = ""
If acAttRef.Tag = "MACHINE_NO" Then
' Here I take the string and put in xl in another sub, for sake of simplicity I just used the msgbox
MsgBox(acAttRef.TextString)
End If
Next
End If
End If
Next
Next
Catch ex As System.Exception
MsgBox("This drawing does not contain and blocks")
End Try
End Using
End Using
acCurDb.Dispose()
acdoc.CloseAndDiscard()
End Sub
I think for the particular block you might be want to use:
#Region "Read Attributes to Excel" <CommandMethod("ReadTitleBlockToExcel", "readbx", CommandFlags.Session)> _ Public Sub TestCmd() ReadData("C:\Test\Temp\Title-1.dwg", "TitleBlock") End Sub Public Sub ReadData(ByVal fName As String, ByVal blkname As String) Dim acdoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.Open(fName, False, Nothing) acdoc = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument Dim acCurDb As Database = acdoc.Database Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() Using mydoclock As DocumentLock = acdoc.LockDocument() Try Dim acBlkTbl As BlockTable = acCurDb.BlockTableId.GetObject(OpenMode.ForRead) If Not acBlkTbl.Has(blkname) Then MsgBox("Block " + blkname + " does not exist") Exit Sub End If Dim btrec As BlockTableRecord = DirectCast(acTrans.GetObject(acBlkTbl(blkname), OpenMode.ForRead, False), BlockTableRecord) Dim idcoll As ObjectIdCollection = btrec.GetBlockReferenceIds(True, True) For Each id As ObjectId In idcoll Dim acObj As DBObject = id.GetObject(OpenMode.ForRead) If TypeOf acObj Is BlockReference Then Dim acBlkRef As BlockReference = DirectCast(acObj, BlockReference) Dim acAttCount As Integer = 1 If acBlkRef.AttributeCollection.Count <> 0 Then For Each acAttId As ObjectId In acBlkRef.AttributeCollection Dim acAttRef As AttributeReference = acAttId.GetObject(OpenMode.ForRead) Dim macNum As String = "" Dim drgName As String = "" Dim drgNum As String = "" If acAttRef.Tag = "MACHINE_NO" Then 'collect data here then pass it to XL after ' Here I take the string and put in xl in another sub, for sake of simplicity I just used the msgbox MsgBox(acAttRef.TextString) End If Next End If End If Next Catch ex As System.Exception MsgBox("This drawing does not contain and blocks") End Try End Using End Using acdoc.CloseAndDiscard() End Sub #End Region
Can't find what you're looking for? Ask the community or share your knowledge.