'=======================================================================
'=======================================================================
' add the block to the ActiveDrawing CurrentSpace
' Imports the Block if not found in the BlockTable
'
' Set ScaleFactor, Rotation and Layer as BlockReference Properties
' The scale can be non-uniform (demonstrated)
'
' Add ALL AttributeReference to the BlockReference
' and Set the attributeText in a nominated Attribute
'
' Includes a test for Layer assertion.
'
' Rotate the nominated Attribute Tag to either UCS, WCS, or Aligned with block insert
<CommandMethod("BI_18")> _
Public Sub BlockInsert_18()
Dim blockQualifiedFileName As String = "K:\ToTest\3Dblock_4A.dwg"
Dim blockName As String = "3DBLOCK_4A"
Dim attTag As String = "ATTRIBUTETAG_MC"
Dim attText As String = "BI_18"
'
Dim scale As Double = 2.5
Dim rotation As Double = RadiansToDegrees(-25.0)
Dim tagRotationAngle As Double = 0.0
Dim layerName As String = "Test BI_18"
' Assert the layer exists
CreateLayer(db, layerName, 8)
Using tr As Transaction = db.TransactionManager.StartTransaction()
Try
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
If Not bt.Has(blockName) Then
Dim tmpDb As New Database(False, True)
tmpDb.ReadDwgFile(blockQualifiedFileName, System.IO.FileShare.Read, True, "")
' add the block to the ActiveDrawing blockTable
db.Insert(blockName, tmpDb, True)
End If
Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Specify insertion point: ")
If ppr.Status <> PromptStatus.OK Then
Return
End If
Dim pkOpt As New PromptKeywordOptions(vbLf & "Rotate Attribute to :")
pkOpt.Keywords.Add("UCS")
pkOpt.Keywords.Add("WCS")
pkOpt.Keywords.Add("Aligned")
Dim prRes As PromptResult = ed.GetKeywords(pkOpt)
If prRes.Status <> PromptStatus.OK Then
Return
End If
Dim btr As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
Using br As New BlockReference(Point3d.Origin, bt(blockName))
br.ScaleFactors = New Scale3d(scale, scale, 1.0)
br.Rotation = rotation
br.Layer = layerName
br.TransformBy(Matrix3d.Displacement(ppr.Value - Point3d.Origin).PreMultiplyBy(ed.CurrentUserCoordinateSystem))
btr.AppendEntity(br)
tr.AddNewlyCreatedDBObject(br, True)
'
InsertAttibuteInBlockRef(br, attTag, attText, tr)
Select Case prRes.StringResult
Case "WCS"
tagRotationAngle = 0.0
Case "UCS"
tagRotationAngle = br.Rotation - rotation
Case "Aligned"
tagRotationAngle = br.Rotation
End Select
For Each idAttColl As ObjectId In br.AttributeCollection
Dim ar As AttributeReference = TryCast(tr.GetObject(idAttColl, OpenMode.ForWrite), AttributeReference)
If ar IsNot Nothing Then
If ar.Tag.ToUpper() = attTag Then
ar.Rotation = tagRotationAngle
End If
End If
Next
End Using
tr.Commit()
Catch exx As Autodesk.AutoCAD.Runtime.Exception
ed.WriteMessage(vbLf & exx.ToString())
End Try
End Using
End Sub
'=======================================================================