Hi All,
Please help me to creat a copy of block definition like autocad (block display beside mouse when we move) and replace some text of attribute.
Thanks,
Solved! Go to Solution.
Solved by ditran7577. Go to Solution.
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
Your subject says copy block reference, but your message says copy block definition.
Which is it?
The DeepCloneObjects() method of the Database class is used to copy objects, so that's what you'd use for copying a block reference. Copying a block definition is a bit more complicated, but also involves the use of DeepCloneObjects()..
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,
Can't find what you're looking for? Ask the community or share your knowledge.