I want copy a block and replace some text string of attribute definition. Here is Kean 's code:
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Internal
Namespace BlockJigTest
Class BlockJig
Inherits EntityJig
Private mCenterPt As Point3d, mActualPoint As Point3d
Public Sub New(br As BlockReference)
MyBase.New(br)
mCenterPt = br.Position
End Sub
Protected Overloads Overrides Function Sampler(prompts As JigPrompts) As SamplerStatus
Dim jigOpts As New JigPromptPointOptions()
jigOpts.UserInputControls = (UserInputControls.Accept3dCoordinates Or UserInputControls.NoZeroResponseAccepted Or UserInputControls.NoNegativeResponseAccepted)
jigOpts.Message = vbLf & "Enter insert point: "
Dim dres As PromptPointResult = prompts.AcquirePoint(jigOpts)
If mActualPoint = dres.Value Then
Return SamplerStatus.NoChange
Else
mActualPoint = dres.Value
End If
Return SamplerStatus.OK
End Function
Protected Overloads Overrides Function Update() As Boolean
mCenterPt = mActualPoint
Try
DirectCast(Entity, BlockReference).Position = mCenterPt
Catch generatedExceptionName As System.Exception
Return False
End Try
Return True
End Function
Public Function GetEntity() As Entity
Return Entity
End Function
End Class
Public Class Commands
<CommandMethod("BJIG")> _
Public Sub CreateBlockWithJig()
Dim doc As Document = Application.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
' First let's get the name of the block
Dim opts As New PromptStringOptions(vbLf & "Enter block name: ")
Dim pr As PromptResult = ed.GetString(opts)
If pr.Status = PromptStatus.OK Then
Dim tr As Transaction = doc.TransactionManager.StartTransaction()
Using tr
' Then open the block table and check the
' block definition exists
Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
If Not bt.Has(pr.StringResult) Then
ed.WriteMessage(vbLf & "Block not found.")
Else
Dim bdId As ObjectId = bt(pr.StringResult)
' We loop until the jig is cancelled
While pr.Status = PromptStatus.OK
' Create the block reference and
' add it to the jig
Dim pt As New Point3d(0, 0, 0)
Dim br As New BlockReference(pt, bdId)
' Start annot-scale support code
Dim bd As BlockTableRecord = DirectCast(tr.GetObject(bdId, OpenMode.ForRead), BlockTableRecord)
' Using will dispose of the block definition
' when no longer needed
Using bd
If bd.Annotative = AnnotativeStates.[True] Then
Dim ocm As ObjectContextManager = db.ObjectContextManager
Dim occ As ObjectContextCollection = ocm.GetContextCollection("ACDB_ANNOTATIONSCALES")
ObjectContexts.AddContext(br, occ.CurrentContext)
End If
End Using
' End annot-scale support code
Dim entJig As New BlockJig(br)
' Perform the jig operation
pr = ed.Drag(entJig)
If pr.Status = PromptStatus.OK Then
' If all is OK, let's go and add the
' entity to the modelspace
Dim ms As BlockTableRecord = DirectCast(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
ms.AppendEntity(entJig.GetEntity())
tr.AddNewlyCreatedDBObject(entJig.GetEntity(), True)
' Start attribute support code
bd = DirectCast(tr.GetObject(bdId, OpenMode.ForRead), BlockTableRecord)
' Add the attributes
For Each attId As ObjectId In bd
Dim ent As Entity = DirectCast(tr.GetObject(attId, OpenMode.ForRead), Entity)
If TypeOf ent Is AttributeDefinition Then
Dim ad As AttributeDefinition = DirectCast(ent, AttributeDefinition)
Dim ar As New AttributeReference()
ar.SetAttributeFromBlock(ad, br.BlockTransform)
br.AttributeCollection.AppendAttribute(ar)
tr.AddNewlyCreatedDBObject(ar, True)
End If
Next
' End attribute support code
' Call a function to make the graphics display
' (otherwise it will only do so when we Commit)
doc.TransactionManager.QueueForGraphicsFlush()
End If
End While
End If
tr.Commit()
End Using
End If
End Sub
End Class
End Namespace It work OK but it is not what i need. I want to get the block by click it and edit textstring of attribute. It's really hard for me to do that. Please help me.
Thanks,
