I am, as of now, trying to learn the VB.NET programming for AutoCAD applications from scratch and I have done a few tutorials and labs from DevTV and googling
The question I wanted to ask the devs out there is that, is there any way or a funtion to move a text object within a layer to a different geometric location? I was thinking it could be accomplished by translating the text or offsetting it. If someone could guide me in the right direction, it would be great help.
And sorry if I mistakingly did not observe forum rules or something
Thanks in advance!
Solved! Go to Solution.
You can move the Text by Changing it's position properties
Imports Autodesk.AutoCAD.Runtime Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.EditorInput Public Class Class2 <CommandMethod("MoveText")> _ Public Sub MoveText() Using db As Database = HostApplicationServices.WorkingDatabase() Using tr As Transaction = db.TransactionManager.StartTransaction() Dim myDWG As Document = Autodesk.AutoCAD.ApplicationServices.Application.D
ocumentManager.MdiActiveDocument Using lock As DocumentLock = myDWG.LockDocument Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices. _ Application.DocumentManager.MdiActiveDocument.Edit or() Dim sOptions As New PromptEntityOptions(vbCr & "Select Text: ") Dim sRes As PromptEntityResult = Nothing While (True) ' Select Text sRes = ed.GetEntity(sOptions) If sRes.Status <> PromptStatus.OK Then Exit While Else Dim obj As Object = tr.GetObject(sRes.ObjectId, OpenMode.ForRead) If TypeOf obj Is DBText Then Dim objdbTEXT As DBText = tr.GetObject(obj.objectid, OpenMode.ForWrite) ' Move Text to Position Dim POINT3D As New Autodesk.AutoCAD.Geometry.Point3d(0, 0, 0) objdbTEXT.Position = POINT3D ' Update Changes db.TransactionManager.QueueForGraphicsFlush() End If End If End While End Using ' Save Changes tr.Commit() End Using End Using End Sub End Class
Thanks Arcticad, Thats a bit much of a code for me. I havent had the chance to see this many fuctions yet.
Ive got a couple more of requests. Could you comment the code that you wrote as well?
and here is another bit of code I am trying to use but for some reason, the objects in the other two layers get green colour inspite of the inner transaction running on the condition of layer 0 selection.
<CommandMethod("SelectObjectsOnscreen")> _ Public Sub SelectObjectsOnscreen() ' Get the current document and database Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument Dim acCurDb As Database = acDoc.Database ' Start a transaction Using acTrans1 As Transaction = acCurDb.TransactionManager.StartTransaction() ' Open the Layer table for read Dim acLyrTbl As LayerTable acLyrTbl = acTrans1.GetObject(acCurDb.LayerTableId, _ OpenMode.ForRead) Dim sLayerName As String = "0" If acLyrTbl.Has(sLayerName) = True Then Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction() ' Request for objects to be selected in the drawing area Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.GetSelection() ' If the prompt status is OK, objects were selected If acSSPrompt.Status = PromptStatus.OK Then Dim acSSet As SelectionSet = acSSPrompt.Value ' Step through the objects in the selection set For Each acSSObj As SelectedObject In acSSet 'Check to make sure a valid SelectedObject object was returned If Not IsDBNull(acSSObj) Then ' Open the selected object for write Dim acEnt As Entity = acTrans.GetObject(acSSObj.ObjectId, _ OpenMode.ForWrite) If Not IsDBNull(acEnt) Then ' Change the object's color to Green acEnt.ColorIndex = 3 End If End If Next If sLayerName = "0" Then ' Save the new object to the database acTrans.Commit() End If End If End Using ' Dispose of the transaction End If acTrans1.Commit() End Using End Sub
Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register