Hi, I know I'm missing something simple. I have sub that moves a cogo point label, (this is not civil 3d related) and there is something funny about my pick point. When I select the base point and then the second point the label moves just fine except it is slightly off from my second pick point. I know it has to do with the base point of the label but I cant for the life of me figure out the correct math to compensate for it. There are two images attached showing my base point pick and second pick. In the second pick image, where the cross-hairs are is where I picked for placement. (I am picking the middle of the zero, and expect the middle of the zero to be at my second point.) Any help would be appreciated.
P.S. I have tried getting the vector from the label base point to first pick point and compensating that into the equation but that did work. (Most likely did it wrong)
<CommandMethod("mcptlbmov")>
Public Sub CogoPointLabelMove()
'Get the current document and editor
Dim curDb As Database = Active.Database
Dim docEd As Editor = Active.Editor
Try
'Create a typedvalue array to define the filter criteria
Dim acTypValAr(0) As TypedValue
acTypValAr.SetValue(New TypedValue(DxfCode.Start, "AECC_COGO_POINT"), 0)
'Assign the filter criteria to a selectionfilter object
Dim acSelFtr As New SelectionFilter(acTypValAr)
'Start cogo point selection prompt option
Dim promptSelectionOptions As New PromptSelectionOptions
promptSelectionOptions.MessageForAdding = (vbLf & "Select COGO Points Labels to move: ")
'Get prompt selection results
Dim cogoPointPromptSelectionResult = docEd.GetSelection(promptSelectionOptions, acSelFtr)
'Set selection set
Dim cogoPointSelectionSet As SelectionSet = cogoPointPromptSelectionResult.Value
'If selection are cogo points
If cogoPointPromptSelectionResult.Status = PromptStatus.OK Then
'Start base point prompt point option
Dim pointPromptOptions = New PromptPointOptions(vbLf & "Specify base point: ")
Dim pointPromptResult = docEd.GetPoint(pointPromptOptions)
'If pick point is valid
If pointPromptResult.Status <> PromptStatus.OK Then
Return
End If
'Set value from point prompt result
Dim firstSelectedPoint = pointPromptResult.Value
'Start second point prompt point option
pointPromptOptions.Message = vbLf & "Specify second point: "
pointPromptOptions.UseBasePoint = True
pointPromptOptions.BasePoint = firstSelectedPoint
pointPromptResult = docEd.GetPoint(pointPromptOptions)
'If pick point is valid
If pointPromptResult.Status <> PromptStatus.OK Then
Return
End If
'Set value from point prompt result
Dim secondSelectedPoint = pointPromptResult.Value
'Get vector between fisrt and second selected 3d points
Dim selectedVector As Vector3d = firstSelectedPoint.GetVectorTo(secondSelectedPoint)
'Get x and y from vector as double
Dim selectedVectorPointY As Double = selectedVector.Y
Dim selectedVectorPointX As Double = selectedVector.X
'Apply move to each selected cogo point
For Each cogoPointSelectedObject In cogoPointSelectionSet
'Start the transaction
Using trans As Transaction = curDb.TransactionManager.StartTransaction()
'Set dbobject and open for write
Dim cogoPointDbOj As Autodesk.AutoCAD.DatabaseServices.DBObject = trans.GetObject(cogoPointSelectedObject.ObjectId, OpenMode.ForWrite)
'Set and cast point
Dim acCogoPoint As CogoPoint = TryCast(cogoPointDbOj, CogoPoint)
'Get cogo point label location and add vector
Dim newCogoPointLabelY As Double = acCogoPoint.LabelLocation.Y + selectedVectorPointY
Dim newCogoPointLabelX As Double = acCogoPoint.LabelLocation.X + selectedVectorPointX
'Set the new cogo point label location
acCogoPoint.LabelLocation = New Point3d(newCogoPointLabelX, newCogoPointLabelY, 0)
'Save the changes and dispose of the transaction
trans.Commit()
End Using
Next
End If
'Regen and update screen
docEd.UpdateScreen()
docEd.Regen()
Catch ex As Exception
