Public Function InsertBlock(ByVal BlockLocation As String) As Boolean ''==== Get active document Dim doc As Document = Application.DocumentManager.MdiActiveDocument ''==== Get database for active document Dim db As Database = doc.Database ''==== Get editor for active document Dim ed As Editor = doc.Editor ''==== Define variable to store prompt result Dim pr As PromptResult 'If pr.Status = PromptStatus.OK Then ''==== Start transaction Using tr As Transaction = db.TransactionManager.StartTransaction() ''==== Lock current document Dim docLock As DocumentLock = doc.LockDocument() ''==== Get block table for current document Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable) ''==== Create temp database to read in block object Dim tempDB As New Database(False, True) ''==== Read DWG and store in temp database tempDB.ReadDwgFile(BlockLocation, FileOpenMode.OpenForReadAndReadShare, True, Nothing) ''==== Get block name from explicit block path Dim blkName As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(BlockLocation) ''==== Insert block object into drawing and store the resultant objectID Dim blkID As ObjectId = db.Insert(blkName, tempDB, True) ''==== Dispose temp database tempDB.Dispose() 'tr.AddNewlyCreatedDBObject(DirectCast(tr.GetObject(blkID, OpenMode.ForRead), DBObject), True) ''==== Check if block table contains block If Not bt.Has(blkName) Then ''==== If not display message and abort transaction ed.WriteMessage(vbLf & "Block not found.") tr.Abort() Else ''==== Get object id from blocktable using block name Dim id As ObjectId = bt(blkName) ''==== Get current space (model/paper) Dim space As BlockTableRecord = DirectCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord) ''==== Get the block table record Dim btr As BlockTableRecord = DirectCast(tr.GetObject(bt(blkName), OpenMode.ForRead), BlockTableRecord) ''==== Create a new block reference from the block definition now stored in database Dim br As New BlockReference(Point3d.Origin, id) ''==== Add block reference to current space space.AppendEntity(br) ''==== Add block to document via transaction tr.AddNewlyCreatedDBObject(br, True) ''==== Create a new attInfo object to store the block table records associated attributes Dim attInfoDict As New Dictionary(Of ObjectId, AttInfo) ''==== Check if block table record contains attributes If btr.HasAttributeDefinitions Then ''==== Iterate all the objectIDs attached to the block table record For Each oId As ObjectId In btr ''==== Get associated object from objectID Dim obj As DBObject = tr.GetObject(oId, OpenMode.ForRead) ''==== Try to cast the object to an attribute definition Dim ad As AttributeDefinition = TryCast(obj, AttributeDefinition) ''==== Check if object was cast to a valid attribute definition If ad IsNot Nothing AndAlso Not ad.Constant Then ''==== Create new attribute reference Dim ar As New AttributeReference() ''==== Set the newly create attribute reference to the block definition and transform by current block transformation ar.SetAttributeFromBlock(ad, br.BlockTransform) ''==== Check if attribute definition justification is anything other than BaseLeft If ad.Justify <> AttachmentPoint.BaseLeft Then ''==== Copy alignment point from definition to reference and transform by current block transofromation ar.AlignmentPoint = ad.AlignmentPoint.TransformBy(br.BlockTransform) End If ''==== If attribute reference is mText If ar.IsMTextAttribute Then ''==== Then update mText ar.UpdateMTextAttribute() End If ''==== Copy text string from attribute definition to attribute reference ar.TextString = ad.TextString ''==== Add attribute reference to block reference attribute collection and store object id Dim arId As ObjectId = br.AttributeCollection.AppendAttribute(ar) ''==== Add attribute reference to document via transaction tr.AddNewlyCreatedDBObject(ar, True) ''==== Add the attribute definition properties and object id of attribute reference to the attInfoDict attInfoDict.Add(arId, New AttInfo(ad.Position, ad.AlignmentPoint, ad.Justify <> AttachmentPoint.BaseLeft)) End If Next End If ''==== Create new instance of the block jig Dim bJig As New BlockJig(br, tr, attInfoDict) ''==== Loop through 0 to 3 to cycle different aspects of the jig For i As Integer = 0 To 3 ''==== Set the jig current input to the value of i bJig.CurrentInput = i ''==== Begin drag (initiate jig user input) pr = ed.Drag(bJig) ''==== Check if user has cancelled or there was an error If (pr.Status = PromptStatus.Cancel Or pr.Status = PromptStatus.Error) Then ''==== Abort and return the function status as false tr.Abort() Return False End If Next tr.Commit() End If 'tr.Commit() End Using 'End If End Function Public Class BlockJig Inherits EntityJig Private m_insertPoint As Point3d Private m_baseAngle, m_xScale, m_yScale, m_RotationAngle As Double Private m_curUCS As Matrix3d = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor.CurrentUserCoordinateSystem Private m_attInfoDict As Dictionary(Of ObjectId, AttInfo) Private m_tr As Transaction Private m_currentInputValue As Integer Private m_uniformScale As Boolean ''==== Property to store current input property ie. Insertion Point, X Scale, Y Scale, Rotation Property CurrentInput() As Integer Get Return m_currentInputValue End Get Set(ByVal value As Integer) m_currentInputValue = value End Set End Property ''==== Create a new instance of the jig Public Sub New(ByVal br As BlockReference, ByVal tr As Transaction, ByVal attInfoDict As Dictionary(Of ObjectId, AttInfo)) MyBase.new(br) m_baseAngle = 0 m_xScale = 1 m_yScale = 1 m_attInfoDict = attInfoDict m_tr = tr End Sub Protected Overrides Function Sampler(ByVal prompts As Autodesk.AutoCAD.EditorInput.JigPrompts) As Autodesk.AutoCAD.EditorInput.SamplerStatus ''==== Select case to define which input property we are addressing ie. Insertion Point, X Scale, Y Scale, Rotation Select Case (m_currentInputValue) ''==== Case is Insertion Point Case 0 ''==== Store existing insertion point if any Dim oldPnt As Point3d = m_insertPoint ''==== Prompt user for insertion point Dim jigPromptResult As PromptPointResult = prompts.AcquirePoint("Insertion point : ") ''==== Check that the user has not cancelled or errored If (jigPromptResult.Status = PromptStatus.OK) Then ''==== Set the m_insertPoint private variable to the value of the jig prompt m_insertPoint = jigPromptResult.Value ''==== Check if insertion point has moved outside of allowed tolerance If (oldPnt.DistanceTo(m_insertPoint) < 0.0001) Then ''==== Return NoChange as placement is within tolerance Return SamplerStatus.NoChange End If End If ''==== Placement has changed so return OK Return SamplerStatus.OK ''==== Case is X Scale Case 1 ''==== Store existing X Scale if any Dim oldXScale As Double = m_xScale ''==== Define prompt options Dim jigPromptDistanceOptions As New JigPromptDistanceOptions(vbLf & "X Scale : ") ''==== Set the default X Scale to 1 jigPromptDistanceOptions.DefaultValue = 1 ''==== Set the jig to get the scale based on the basepoint jigPromptDistanceOptions.UseBasePoint = True jigPromptDistanceOptions.UserInputControls = UserInputControls.NullResponseAccepted ''==== Set the basepoint to the insertion point of the block jigPromptDistanceOptions.BasePoint = m_insertPoint ''==== Prompt user for X Scale by passing prompt options defined above Dim jigPromptPointResult As PromptDoubleResult = prompts.AcquireDistance(jigPromptDistanceOptions) ''==== Check that the user has not cancelled or errored If (jigPromptPointResult.Status = PromptStatus.OK) Then ''==== Set the m_xScale private variable to the value of the jig prompt m_xScale = jigPromptPointResult.Value ''==== Check if X scale value is outside of allowed tolerance If (System.Math.Abs(oldXScale) - System.Math.Abs(m_xScale)) < 0.0001 Then ''==== Return NoChange as X scale is within tolerance Return SamplerStatus.NoChange End If End If ''==== X scale has changed so return OK Return SamplerStatus.OK ''==== Case is Y Scale Case 2 ''==== Store existing Y Scale if any Dim oldYScale As Double = m_yScale ''==== Define prompt options Dim jigPromptDistanceOptions As New JigPromptDistanceOptions(vbLf & "Y Scale : ") ''==== Set the default Y Scale to 1 jigPromptDistanceOptions.DefaultValue = 1 ''==== Set the jig to get the scale based on the basepoint jigPromptDistanceOptions.UseBasePoint = True jigPromptDistanceOptions.UserInputControls = UserInputControls.NullResponseAccepted ''==== Set the basepoint to the insertion point of the block jigPromptDistanceOptions.BasePoint = m_insertPoint ''==== Prompt user for Y Scale by passing prompt options defined above Dim jigPromptPointResult As PromptDoubleResult = prompts.AcquireDistance(jigPromptDistanceOptions) ''==== Check that the user has not cancelled or errored If (jigPromptPointResult.Status = PromptStatus.OK) Then ''==== Set the m_yScale private variable to the value of the jig prompt m_yScale = jigPromptPointResult.Value ''==== Check if Y scale value is outside of allowed tolerance If (System.Math.Abs(oldYScale) - System.Math.Abs(m_yScale)) < 0.0001 Then ''==== Return NoChange as Y scale is within tolerance Return SamplerStatus.NoChange End If End If ''==== Y scale has changed so return OK Return SamplerStatus.OK ''==== Case is Rotation Case 3 ''==== Define prompt options Dim jigPromptAngleOptions As New JigPromptAngleOptions(vbLf & "Rotation : ") ''==== Set the default X Scale to 1 jigPromptAngleOptions.DefaultValue = 0 ''==== Set the jig to get the scale based on the basepoint jigPromptAngleOptions.UseBasePoint = True ''==== Set the basepoint to the insertion point of the block jigPromptAngleOptions.BasePoint = m_insertPoint jigPromptAngleOptions.UserInputControls = UserInputControls.NullResponseAccepted ''==== Prompt user for Rotation by passing prompt options defined above Dim jigPromptAngleResult As PromptDoubleResult = prompts.AcquireAngle(jigPromptAngleOptions) ''==== Check that the user has not cancelled or errored If (jigPromptAngleResult.Status = PromptStatus.OK) Then ''==== Declare temp variable to store rotation value Dim TempRotationValue As Double ''==== Check if there is a string result from the jig prompt If Not String.IsNullOrEmpty(jigPromptAngleResult.StringResult) Then ''==== If there is a string result, store in TempRotationValue variable TempRotationValue = CDbl(jigPromptAngleResult.StringResult) Else ''==== If not store the value in TempRotationValue variable TempRotationValue = jigPromptAngleResult.Value End If ''==== Check if the stored value is the same as the current jig angle If TempRotationValue = m_baseAngle Then ''==== If it is, report no change Return SamplerStatus.NoChange Else ''==== Set the m_RotationAngle private variable to the value of the jig prompt m_RotationAngle = TempRotationValue ''==== Check if Rotation angle value is outside of allowed tolerance If (System.Math.Abs(m_baseAngle) - System.Math.Abs(m_RotationAngle)) < 0.0001 Then ''==== Return NoChange as rotation is within tolerance Return SamplerStatus.NoChange End If End If End If ''==== Y scale has changed so return OK Return SamplerStatus.OK End Select End Function Protected Overrides Function Update() As Boolean ''==== Cast the passed entity to a Block Reference Dim br As BlockReference = DirectCast(Entity, BlockReference) ''==== Select case to define which input property we are addressing ie. Insertion Point, X Scale, Y Scale, Z Scale, Rotation Select Case (m_currentInputValue) ''==== Case is Insertion Point Case 0 ''==== Set the position of the Block Reference to the m_insertPoint variable br.Position = m_insertPoint 'If br.AttributeCollection.Count <> 0 Then ' ''==== Iterate all the objectIDs attached to the block reference ' For Each oId As ObjectId In br.AttributeCollection ' ''==== Get associated object from objectID ' Dim obj As DBObject = m_tr.GetObject(oId, OpenMode.ForRead) ' ''==== Try to cast the object to an attribute reference ' Dim ar As AttributeReference = TryCast(obj, AttributeReference) ' ''==== Check if object was cast to a valid attribute definition ' If ar IsNot Nothing Then ' ''==== Upgrade to write access ' ar.UpgradeOpen() ' ''==== Get the attribute info for the current attribute reference ' Dim curAttInfo As AttInfo = m_attInfoDict(ar.ObjectId) ' ''==== Set the attribute reference position to the current block transformation ' ar.Position = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' ''==== Check if attribute reference is aligned ' If curAttInfo.IsAligned Then ' ''==== If it is, transform by current block transformation ' ar.AlignmentPoint = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' End If ' ''==== If attribute reference is mText ' If ar.IsMTextAttribute Then ' ''==== Then update mText ' ar.UpdateMTextAttribute() ' End If ' ar.DowngradeOpen() ' End If ' Next 'End If Case 1 ''==== Set the scale of the Block Reference to the m_xScale variable br.ScaleFactors = New Scale3d(m_xScale, m_xScale, m_xScale) 'If br.AttributeCollection.Count <> 0 Then ' ''==== Iterate all the objectIDs attached to the block reference ' For Each oId As ObjectId In br.AttributeCollection ' ''==== Get associated object from objectID ' Dim obj As DBObject = m_tr.GetObject(oId, OpenMode.ForRead) ' ''==== Try to cast the object to an attribute reference ' Dim ar As AttributeReference = TryCast(obj, AttributeReference) ' ''==== Check if object was cast to a valid attribute definition ' If ar IsNot Nothing Then ' ''==== Upgrade to write access ' ar.UpgradeOpen() ' ''==== Get the attribute info for the current attribute reference ' Dim curAttInfo As AttInfo = m_attInfoDict(ar.ObjectId) ' ''==== Set the attribute reference position to the current block transformation ' ar.Position = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' ''==== Check if attribute reference is aligned ' If curAttInfo.IsAligned Then ' ''==== If it is, transform by current block transformation ' ar.AlignmentPoint = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' End If ' ''==== If attribute reference is mText ' If ar.IsMTextAttribute Then ' ''==== Then update mText ' ar.UpdateMTextAttribute() ' End If ' ''=== This? ' 'Dim scaleMatrix As Matrix3d = Matrix3d.Scaling(m_xScale, ar.Position) ' 'ar.TransformBy(scaleMatrix) ' ''=== Or this? ' ar.TransformBy(br.ScaleFactors.GetMatrix) ' 'AttSync??? ' End If ' Next 'End If Case 2 ''==== Set the scale of the Block Reference to the m_yScale variable br.ScaleFactors = New Scale3d(m_xScale, m_yScale, m_xScale) 'If br.AttributeCollection.Count <> 0 Then ' ''==== Iterate all the objectIDs attached to the block reference ' For Each oId As ObjectId In br.AttributeCollection ' ''==== Get associated object from objectID ' Dim obj As DBObject = m_tr.GetObject(oId, OpenMode.ForRead) ' ''==== Try to cast the object to an attribute reference ' Dim ar As AttributeReference = TryCast(obj, AttributeReference) ' ''==== Check if object was cast to a valid attribute definition ' If ar IsNot Nothing Then ' ''==== Upgrade to write access ' ar.UpgradeOpen() ' ''==== Get the attribute info for the current attribute reference ' Dim curAttInfo As AttInfo = m_attInfoDict(ar.ObjectId) ' ''==== Set the attribute reference position to the current block transformation ' ar.Position = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' ''==== Check if attribute reference is aligned ' If curAttInfo.IsAligned Then ' ''==== If it is, transform by current block transformation ' ar.AlignmentPoint = curAttInfo.Alignment.TransformBy(br.BlockTransform) ' End If ' ''==== If attribute reference is mText ' If ar.IsMTextAttribute Then ' ''==== Then update mText ' ar.UpdateMTextAttribute() ' End If ' ''=== This? ' 'Dim scaleMatrix As Matrix3d = Matrix3d.Scaling(m_yScale, ar.Position) ' 'ar.TransformBy(scaleMatrix) ' ''=== Or this? ' ar.TransformBy(br.ScaleFactors.GetMatrix) ' 'AttSync??? ' End If ' Next 'End If Case 3 ''==== Check that rotation has changed If m_RotationAngle > Tolerance.Global.EqualPoint Then ''==== Create a transformation matrix based on current jig rotation value (m_RotationAngle) minus existing rotation value (m_BaseAngle) Dim transformation As Matrix3d = Matrix3d.Rotation(m_RotationAngle - m_baseAngle, m_curUCS.CoordinateSystem3d.Zaxis, m_insertPoint) ''==== Apply transformation matrix to block reference br.TransformBy(transformation) ''==== Store current rotation m_baseAngle = m_RotationAngle End If End Select If br.AttributeCollection.Count <> 0 Then ''==== Iterate all the objectIDs attached to the block reference For Each oId As ObjectId In br.AttributeCollection ''==== Get associated object from objectID Dim obj As DBObject = m_tr.GetObject(oId, OpenMode.ForRead) ''==== Try to cast the object to an attribute reference Dim ar As AttributeReference = TryCast(obj, AttributeReference) ''==== Check if object was cast to a valid attribute definition If ar IsNot Nothing Then ''==== Upgrade to write access ar.UpgradeOpen() ''==== Get the attribute info for the current attribute reference Dim curAttInfo As AttInfo = m_attInfoDict(ar.ObjectId) ''==== Set the attribute reference position to the current block transformation ar.Position = curAttInfo.Alignment.TransformBy(br.BlockTransform) ''==== Check if attribute reference is aligned If curAttInfo.IsAligned Then ''==== If it is, transform by current block transformation ar.AlignmentPoint = curAttInfo.Alignment.TransformBy(br.BlockTransform) End If ''==== If attribute reference is mText If ar.IsMTextAttribute Then ''==== Then update mText ar.UpdateMTextAttribute() End If ar.DowngradeOpen() End If Next End If End Function End Class