Message 1 of 8
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I have a block of code that inserts a block and populates 2 attributes.
If i run the code directly it inserts the block and populates the atts fine.
if i run the same block of code while iterating through a table, to pass a value for the atts,
the blocks appear to insert. once the table read completes the blocks all disapear.
Thoughts?
Public Sub ReadBOM()
'Read table populate the atts array
Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim acBlkTbl As BlockTable
Dim acBlkTblRec As BlockTableRecord
Dim TagV As String 'Atts(1)
' Dim cntx As Int16
Dim acTbl As Table = Nothing
Using doc.LockDocument
Using acTrans As Transaction = db.TransactionManager.StartTransaction()
acBlkTbl = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForRead)
Dim Res As PromptSelectionResult = ed.GetSelection
Dim acSSet As SelectionSet = Res.Value
'' Step through the objects in the selection set
For Each acSSObj As SelectedObject In acSSet
Dim ent As Entity = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForRead)
Try
If TypeOf ent Is Table Then
acTbl = ent
' MsgBox("before loop " & acTbl.Cells)
Dim TbName As String = acTbl.Cells(0, 0).Value.ToString
'MsgBox(TbName)
'iterate through table
For cnt1 = 1 To acTbl.Rows.Count - 2
TagV = acTbl.Cells(cnt1 + 1, 0).Value.ToString 'looking in row no 3 (4th actual row)
InsertElecTagBlock(TagV) ' works kinda but block disapears
Next
End If
Catch ex As Autodesk.AutoCAD.Runtime.Exception
MsgBox("F#%K!!! " & ex.Message)
End Try
Next
End Using
End Using
End Sub
Public Sub InsertElecTagBlock(TagVal As String)
Dim BlkN As String = "C:\Vault\CADD Standards\CADD Support Files\Symbols\Electrical\Elect GA Symbols\ITag.dwg"
'insert the block and populate attribute.
Using lock As DocumentLock = Application.DocumentManager.MdiActiveDocument.LockDocument
Dim DOC As Document = Application.DocumentManager.MdiActiveDocument
Dim acDatabase As Database = DOC.Database
Using acTrans As Transaction = DOC.TransactionManager.StartTransaction()
Dim ed As Editor = DOC.Editor
ed.UpdateScreen()
Dim blktable As BlockTable = acTrans.GetObject(acDatabase.BlockTableId, OpenMode.ForWrite)
Dim pprSpace As BlockTableRecord = CType(acTrans.GetObject(acDatabase.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Dim blkRec As BlockTableRecord
Dim blkRef As BlockReference
InsPoint = New Point3d(0, 0, 0)
'Try to find electrical tag exists:
If Not blktable.Has(TagName) Then
Dim extDB As New Database(False, True)
extDB.ReadDwgFile(BlkN, IO.FileShare.Read, True, "")
Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(BlkN)
Dim objID As ObjectId = acDatabase.Insert(name, extDB, True)
blkRef = New BlockReference(InsPoint, objID)
blkRec = acTrans.GetObject(blkRef.BlockTableRecord, OpenMode.ForWrite)
Else
blkRec = acTrans.GetObject(blktable(TagName), OpenMode.ForWrite)
blkRef = New BlockReference(InsPoint, blkRec.ObjectId)
End If
DOC.Window.Focus()
Dim ppr As PromptPointResult
blkRef.Layer = "0"
pprSpace.AppendEntity(blkRef)
'Get and activate atts:
For Each attID As ObjectId In blkRec
Dim obj As DBObject = acTrans.GetObject(attID, OpenMode.ForRead)
Try
Dim attdef As AttributeDefinition = CType(obj, AttributeDefinition)
Dim attref As New AttributeReference
attref.SetAttributeFromBlock(attdef, blkRef.BlockTransform)
blkRef.AttributeCollection.AppendAttribute(attref)
acTrans.AddNewlyCreatedDBObject(attref, True)
Catch
End Try
Next
For Each attID As ObjectId In blkRef.AttributeCollection
Dim attRef As AttributeReference = acTrans.GetObject(attID, OpenMode.ForWrite)
If attRef.Tag = "P_ITEM" Then
attRef.TextString = TagVal 'change after split
ElseIf attRef.Tag = "P_TEXT" Then
attRef.TextString = TagVal 'change after split
End If
Next
'Rotate Block?:
If RotateBool = True Then
blkRef.TransformBy(Matrix3d.Rotation(DegToRad(90), blkRef.Normal, blkRef.Position))
Else
blkRef.TransformBy(Matrix3d.Rotation(DegToRad(0), blkRef.Normal, blkRef.Position))
End If
acTrans.AddNewlyCreatedDBObject(blkRef, True)
ed.UpdateScreen()
''Drag the block: =======================================================
Dim psr As PromptSelectionResult = ed.SelectLast
If (psr.Status = PromptStatus.OK) Then
Dim pdo As New PromptDragOptions(psr.Value, "", New DragCallback(AddressOf MyDragCallback))
With pdo
.Message = CommandPrompt
.Keywords.Add("ROTATE", "R", "Rotate", True, True)
End With
pdo.Keywords.Default = "ROTATE"
'Drag
ppr = ed.Drag(pdo)
'Insertion Point picked:
If ppr.Status = PromptStatus.OK Then
Dim mat As Matrix3d = Matrix3d.Displacement(InsPoint.GetVectorTo(ppr.Value))
blkRef.TransformBy(mat)
ElseIf ppr.Status = PromptStatus.Keyword Then
'Rotate and start again:
If ppr.StringResult.ToUpper() = "ROTATE" Then
blkRef.Erase()
RotateBool = Not RotateBool
'RepeatBool = True
'newPrefix = True
GoTo QuickExit
End If
Else
blkRef.Erase()
GoTo QuickExit
End If
End If
QuickExit:
'Commit Transaction:
acTrans.Commit()
ed.Regen()
ed.UpdateScreen()
End Using 'End trans
End Using 'end lock
End SubSolved! Go to Solution.
