Message 1 of 6
Move Multiple Cogo Point Labels with Jig
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi,
I am trying to update a program I found to incorporate a Jig so the user can see what is happening. I am having some trouble getting it work correctly and was wondering if someone could help. The program allows a user to select a cogopoint or multiple and move the label, not the point, to a new location. As it stands without the jig it works. (Test 1) But you can not really see where you are moving it. Hence the Jig. I have only worked with Jigs twice before and that was for placing an object at a point. Not selecting a base point and second point. I think I need a DrawJig over an EntityJig. I have been playing with both with no luck.
Test 1 is the found program updated to use with selection points vs the typed values in the found routine.
Test 4 is a really nice Jig for selecting multiple Entities I found and works great.
I have been playing with this for a while now and cant figure out to incorporate the two.
Any help would be greatly appreciated.
Test 1:
Public Class test1
<CommandMethod("test1")>
Public Sub PointLabelMove()
'Get the current document and editor
Dim acCurDb As Database = Active.Database
Dim acDocEd As Editor = Active.Editor
Dim acDoc As Document = Active.Document
Try
'Start cogo point selection prompt option
Dim cogopointPrompt As PromptSelectionOptions = New PromptSelectionOptions
cogopointPrompt.MessageForAdding = vbLf & "Select Cogo Points to move labels: "
'Set cogo point selection result
Dim selectedCogoPoints As PromptSelectionResult = acDocEd.GetSelection(cogopointPrompt)
'If selection is a cogo point
If selectedCogoPoints.Status <> PromptStatus.OK Then Return
'Set variables for prompt point options and results
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
'Prompt for start point
pPtOpts.Message = vbLf & "Specify base point: "
pPtRes = acDoc.Editor.GetPoint(pPtOpts)
Dim ptStart As Point3d = pPtRes.Value
'Convert 3d point to 2d
ptStart.Converttopoint2d
'Get x and y values for start
Dim ptStartX = ptStart.X
Dim ptStartY = ptStart.Y
'Exit if cancels command
If pPtRes.Status = PromptStatus.Cancel Then Exit Sub
'Prompt for end point
pPtOpts.Message = vbLf & "Specify second point: "
pPtOpts.UseBasePoint = True
pPtOpts.BasePoint = ptStart
pPtRes = acDoc.Editor.GetPoint(pPtOpts)
Dim ptEnd As Point3d = pPtRes.Value
'Convert 3d point to 2d
ptEnd.Converttopoint2d
'Get x and y values for end
Dim ptEndX = ptEnd.X
Dim ptEndY = ptEnd.Y
'Exit if cancels command
If pPtRes.Status = PromptStatus.Cancel Then Exit Sub
'Start the transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'If selection is not less then 0
If selectedCogoPoints.Value.Count > 0 Then
For Each selectedCogoPoint As SelectedObject In selectedCogoPoints.Value
'Get cogo point reference objectid
Dim selectedCogoPointId As ObjectId = selectedCogoPoint.ObjectId
Dim selCogoPoint As CogoPoint = acTrans.GetObject(selectedCogoPointId, 1)
'Get cogo point label location
Dim cogoPointLabelY As Double = selCogoPoint.LabelLocation.Y + ptEndY - ptStartY
Dim cogoPointLabelX As Double = selCogoPoint.LabelLocation.X + ptEndX - ptStartX
'Set the new cogo point label location
Dim pointd As Point3d = New Point3d(selCogoPoint.Location.X, selCogoPoint.Location.Y, 0)
selCogoPoint.LabelLocation = New Point3d(cogoPointLabelX, cogoPointLabelY, 0)
Next
End If
'Save the changes and dispose of the transaction
acTrans.Commit()
'Regen and update screen
acDocEd.UpdateScreen()
acDocEd.Regen()
End Using
Catch ex As Exception
'To Do...
End Try
End Sub
End ClassTest 4:
Public Class test4
<CommandMethod("test4", CommandFlags.UsePickSet)>
Public Sub Test()
Dim doc = Application.DocumentManager.MdiActiveDocument
Dim db = doc.Database
Dim ed = doc.Editor
Dim selection = ed.GetSelection()
If selection.Status <> PromptStatus.OK Then Return
Dim ptResult = ed.GetPoint(vbLf & "Base point: ")
If ptResult.Status <> PromptStatus.OK Then Return
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim entities As Autodesk.AutoCAD.DatabaseServices.Entity() = New Autodesk.AutoCAD.DatabaseServices.Entity(selection.Value.Count - 1) {}
For i As Integer = 0 To selection.Value.Count - 1
entities(i) = CType(tr.GetObject(selection.Value(i).ObjectId, OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.Entity)
Next
Dim jig = New MoveJig(entities, ptResult.Value.TransformBy(ed.CurrentUserCoordinateSystem))
Dim result = ed.Drag(jig)
If result.Status = PromptStatus.OK Then
For Each ent In entities
ent.UpgradeOpen()
ent.TransformBy(jig.Displacement)
Next
End If
tr.Commit()
ed.UpdateScreen()
ed.Regen()
End Using
End Sub
End Class
Public Class MoveJig
Inherits DrawJig
Protected basePt As Point3d
Protected entities As Autodesk.AutoCAD.DatabaseServices.Entity()
Public Sub New(ByVal entities As Autodesk.AutoCAD.DatabaseServices.Entity(), ByVal basePt As Point3d)
Me.entities = entities
Me.basePt = basePt
End Sub
Public Property Displacement As Matrix3d
Protected Overrides Function Sampler(ByVal prompts As JigPrompts) As SamplerStatus
Dim options = New JigPromptPointOptions(vbLf & "Second point: ")
options.UserInputControls = UserInputControls.Accept3dCoordinates
options.BasePoint = basePt
options.UseBasePoint = True
options.Cursor = CursorType.RubberBand
Dim result = prompts.AcquirePoint(options)
If basePt.DistanceTo(result.Value) < Tolerance.[Global].EqualPoint Then Return SamplerStatus.NoChange
Displacement = Matrix3d.Displacement(result.Value - basePt)
Return SamplerStatus.OK
End Function
Protected Overrides Function WorldDraw(ByVal draw As WorldDraw) As Boolean
Dim geo = draw.Geometry
If geo IsNot Nothing Then
geo.PushModelTransform(Displacement)
For Each ent In entities
geo.Draw(ent)
Next
geo.PopModelTransform()
End If
Return True
End Function
End Class
