I'm trying to write a routine that will insert a block (with attributes) in the current UCS. I have cobbled this together from a few different sources, but I can't quite get the orientation to work consistently. I've tried a couple different examples of TransformBy on the block, but neither works consistently correctly.
Any ideas?
Also... How do I exit cleanly? When I'm done with my routine, it leaves the command line in a state that is not ready (no prompt). I have to hit Esc or Enter to get back the command prompt.
Public Sub InsertDrawingAsBlock(ByVal doc As Document, ByVal path As String, ByVal blockname As String, _
ByVal iPt As Point3d, Optional ByVal Space As String = "Model", _
Optional ByVal LayerName As String = "Misc", Optional ByVal Xplode As Boolean = False, _
Optional ByVal bRotate As Double = 0.0, Optional ByVal bXScale As Single = 1.0, _
Optional ByVal bYScale As Single = 1.0, Optional ByVal bZScale As Single = 1.0)
Dim curdb As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim loc As DocumentLock = doc.LockDocument()
Dim ucsMat As Matrix3d = ed.CurrentUserCoordinateSystem
Using loc
Dim blkid As ObjectId = ObjectId.Null
Dim db As New Database(False, True)
Using db
db.ReadDwgFile(path, System.IO.FileShare.Read, True, "")
blkid = curdb.Insert(path, db, True)
Using tr As Transaction = doc.TransactionManager.StartTransaction()
Dim btr As BlockTableRecord = DirectCast(curdb.CurrentSpaceId.GetObject(OpenMode.ForWrite), BlockTableRecord)
Dim bt As BlockTable = DirectCast(tr.GetObject(curdb.BlockTableId, OpenMode.ForRead), BlockTable)
If bt.Has(blockname) Then
Dim btrId As ObjectId = bt(blockname).GetObject(OpenMode.ForRead).ObjectId
btr.UpgradeOpen()
Dim bref As New BlockReference(iPt, btrId)
btr.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
Else
bt.UpgradeOpen()
Dim btrec As BlockTableRecord = DirectCast(blkid.GetObject(OpenMode.ForRead), BlockTableRecord)
btrec.UpgradeOpen()
btrec.Name = blockname
btrec.DowngradeOpen()
Using btr
'iPt = iPt.TransformBy(ucsMat)
Using bref As New BlockReference(iPt, blkid)
Dim mat As Matrix3d = Matrix3d.Identity
bref.TransformBy(mat)
'bref.TransformBy(ucsMat)
'Rotate
bref.Rotation = bRotate * (Math.PI / 180)
'Scale factor
bref.ScaleFactors = New Scale3d(bXScale, bYScale, bZScale)
btr.AppendEntity(bref)
tr.AddNewlyCreatedDBObject(bref, True)
Using btAttRec As BlockTableRecord = DirectCast(bref.BlockTableRecord.GetObject(OpenMode.ForRead), BlockTableRecord)
Dim atcoll As Autodesk.AutoCAD.DatabaseServices.AttributeCollection = bref.AttributeCollection
For Each subid As ObjectId In btAttRec
Dim ent As Entity = DirectCast(subid.GetObject(OpenMode.ForRead), Entity)
Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition)
If attDef IsNot Nothing Then
'ed.WriteMessage(vbLf & "Value: " + attDef.TextString)
Dim attRef As New AttributeReference()
attRef.SetPropertiesFrom(attDef)
attRef.Visible = attDef.Visible
attRef.SetAttributeFromBlock(attDef, bref.BlockTransform)
attRef.HorizontalMode = attDef.HorizontalMode
attRef.VerticalMode = attDef.VerticalMode
attRef.Rotation = attDef.Rotation
attRef.TextStyleId = attDef.TextStyleId
attRef.Position = attDef.Position + iPt.GetAsVector()
attRef.Tag = attDef.Tag
attRef.FieldLength = attDef.FieldLength
attRef.TextString = attDef.TextString
attRef.AdjustAlignment(curdb)
atcoll.AppendAttribute(attRef)
tr.AddNewlyCreatedDBObject(attRef, True)
End If
Next
End Using
bref.DowngradeOpen()
'Does it need to be exploded?
If Xplode = True Then
bref.ExplodeToOwnerSpace()
bref.Erase()
End If
End Using
End Using
btrec.DowngradeOpen()
bt.DowngradeOpen()
ed.Regen()
End If
tr.Commit()
End Using
End Using
End Using
End Sub