Hi Curtis,
I have a solution here that might be of interest; it's one of those things that could very well be over complicated, but was created in a moment of need..
I have it so the dim object is selected, however, it just needs to be feed with your objects. Key driving variables are 'TextQuadrant' & 'TextPositionRadius'.
Public Sub RepositionAngluarDimText()
Dim oDim As DrawingDimension
oDim = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingDimensionFilter, "Select the face")
'oDim = Nothing 'Your dim object
Dim oCurve1 As DrawingCurve = oDim.IntentOne.Geometry.Segments(1).Parent
Dim oCurve2 As DrawingCurve = oDim.Intenttwo.Geometry.Segments(1).Parent
'get curve points
Dim C1strt, C1end As Point2d
C1strt = oCurve1.StartPoint
C1end = oCurve1.EndPoint
Dim C2strt, C2end As Point2d
C2strt = oCurve2.StartPoint
C2end = oCurve2.EndPoint
'get coords of curve points
Dim x1, y1, x2, y2 As Double
Dim a1, b1, a2, b2 As Double
x1 = C1strt.X
y1 = C1strt.Y
x2 = C1end.X
y2 = C1end.Y
a1 = C2strt.X
b1 = C2strt.Y
a2 = C2end.X
b2 = C2end.Y
'find x,y intersection of curves in order to get the centre point of the dim
Dim intersect As Double() = SlopeIntersectPoint(x1, y1, x2, y2, a1, b1, a2, b2)
Dim intersectx As Double = intersect(0)
Dim intersecty As Double = intersect(1)
'set text 'quadrant' position
Dim TextPositionRadius As Double = 1.5
Dim TextQuadrant As String = "1x"
Dim textPos As Double() = TextQuadrantPosition(intersectx, intersecty, TextPositionRadius, TextQuadrant )
Dim textX As Double = textPos(0)
Dim textY As Double = textPos(1)
Dim oTG As TransientGeometry
oTG = g_invApp.TransientGeometry
Dim oTextOrigin As Point2d = oTG.CreatePoint2d(textX, textY)
oDim.Text.Origin = oTextOrigin
oDim.CenterText
End Sub
Getting the slope intersection of the drawing curves: Note; method will error out on parallel lines.. but won't be an issue on angular dims.
Private Function SlopeIntersectPoint(X1 As Double, Y1 As Double, X2 As Double, Y2 As Double,
A1 As Double, B1 As Double, A2 As Double, B2 As Double) As Double()
Dim dx As Double
Dim dy As Double
Dim da As Double
Dim db As Double
Dim t As Double
dx = X2 - X1
dy = Y2 - Y1
da = A2 - A1
db = B2 - B1
If (da * dy - db * dx) = 0 Then
' The segments are parallel.
Return {dx, dy}
End If
t = (da * (Y1 - B1) + db * (A1 - X1)) / (db * dx - da * dy)
Dim IntersectPoint As Double()
IntersectPoint = {X1 + t * dx, Y1 + t * dy }
Return IntersectPoint
End Function
Lastly, returning the coords of the desired quadrant.
Private Function TextQuadrantPosition(intersectx As Double, intersecty As Double, rad As Double, quad As String) As Double()
Dim nudge As Double = 0.3
Dim x, y As Double
'Four quadrants based on x & y axis. Where (+x,+y) is the first quadrant, then clockwise through subsequent quadrants: 1 = (+x,+y), 2 = (+x-y), 3 = (-x-y), 4 = (-x,+y)
'Each quadrant is split in to two along the 45 degree, giving additional positional control, as four quadrants isn't often enough. eg 1x, 1y, 2x, 2y ...
'1x would place in the lower 45 of the quadrant "1". 1y would be the upper 45 of the quadrant "1".
'2x would place in the upper of quadrant 2. 2y would place in the lower of quadrant 2
'The 'nudge' variable nudges the text position To the left, Right, above, or below the axis lines.. This allows us to make use of the 'Dim.CenterText' which centres the text in it's quadrant.
'the nudge variable could be used to precisely place the text with relative ease.
Select Case quad
' '---------------------------------------
Case ("1")
x = intersectx + rad
y = intersecty + nudge
Case "1x"
x = intersectx + rad
y = intersecty + nudge
Case "1y"
x = intersectx + nudge
y = intersecty + rad
'---------------------------------------
Case "2"
x = intersectx + nudge
y = intersecty - rad
Case "2x"
x = intersectx + rad
y = intersecty - nudge
Case "2y"
x = intersectx + nudge
y = intersecty - rad
'---------------------------------------
Case "3"
x = intersectx - rad
y = intersecty - nudge
Case "3x"
x = intersectx - rad
y = intersecty - nudge
Case "3y"
x = intersectx - nudge
y = intersecty - rad
'---------------------------------------
Case "4"
x = intersectx - nudge
y = intersecty + rad
Case "4x"
x = intersectx - rad
y = intersecty + nudge
Case "4y"
x = intersectx - nudge
y = intersecty + rad
'---------------------------------------
Case Else
x = intersectx
y = intersecty
End Select
Return {x, y}
End Function
It wouldn't be too far fetched to modify this for a bit more automation around quadrants and radius, I just never got that far.
Something using the below could be worked in; by finding the inclination of the drawing curves it is probably possible to auto select the quadrant.
Public Shared Function LineInclinationFromXAxis(x1 As Double, y1 As Double,
x2 As Double, y2 As Double) As Double
Dim theta As Double
theta = Math.Atan2((y2 - y1), (x2 - x1))
LineInclinationFromXAxis = theta
End Function
Hopefully of some use.