Text on a line problem

Hi

I hope some one can help me. I have written a set of VBA code to place text centrally over a line or below the line by selecting an existing line object by using obj.AttachmentPoint = acAttachmentPointBottomCenter this if fine for on top of the line by using obj.AttachmentPoint = acAttachmentPointTopCenter below the line places the text so that the top of the text is crossing the line. How can I offset the below the line so that it is clear of the line object.

Thanks

Noel

 

Code:

Public Function CalcTextBasePoint(ALine As AcadLine, Distance As Double) As Variant

Dim BasePoint(0 To 2) As Double
Dim Slope As Double
Dim XOffset As Double
Dim YOffset As Double


'--Find the midpoint of the line.
BasePoint(0) = ((ALine.EndPoint(0) - ALine.StartPoint(0)) / 2#) + ALine.StartPoint(0)
BasePoint(1) = ((ALine.EndPoint(1) - ALine.StartPoint(1)) / 2#) + ALine.StartPoint(1)
BasePoint(2) = 0#

'--Find the slope of the line
Slope = (ALine.EndPoint(1) - ALine.StartPoint(1)) / (ALine.EndPoint(0) - ALine.StartPoint(0))

'--If the line slopes up, we need to add the X offest value and subtract the Y.
'--If the line slopes down, we need to subtract the X offset value and add the Y.
If Slope >= 0 Then
XOffset = Distance * Cos(ALine.Angle)
YOffset = Distance * Sin(ALine.Angle) * -1
Else
XOffset = Distance * Cos(ALine.Angle) * -1#
YOffset = Distance * Sin(ALine.Angle)
End If

'--Calculate the new base point.
BasePoint(0) = BasePoint(0) + XOffset
BasePoint(1) = BasePoint(1) + YOffset

CalcTextBasePoint = BasePoint
End Function

Public Sub TestBasePoint()
Dim ALine As AcadLine
Dim StartPoint(0 To 2) As Double
Dim EndPoint(0 To 2) As Double
Dim Text As AcadText
Dim InsertionPoint(0 To 2) As Double
Dim BasePoint As Variant

StartPoint(0) = 0#
StartPoint(1) = 0#
StartPoint(2) = 0#

EndPoint(0) = 10#
EndPoint(1) = 10#
EndPoint(2) = 0#

Set ALine = ThisDrawing.ModelSpace.AddLine(StartPoint, EndPoint)

BasePoint = CalcTextBasePoint(ALine, 0.2)
InsertionPoint(0) = BasePoint(0)
InsertionPoint(1) = BasePoint(1)
InsertionPoint(2) = BasePoint(2)

Set Text = ThisDrawing.ModelSpace.AddText("TEST", InsertionPoint, 0.5)
Text.Alignment = acAlignmentTopCenter
Text.TextAlignmentPoint = InsertionPoint
Text.Rotation = ALine.Angle
End Sub

 

Jackrabbit's solution is certainly more elegant, and IMO, generally
preferred, but you can also concatenate a vbCr for a similar, code-less
solution.

I wrote the same kind of thing and did the cheating, vbCr way.

 

I should have specified that if you use the vbCr, you wouldn't want to use
TC justification. Use the same justification as the prior line.

 

Thanks Jackrabbit and TodD

Jackrabbit the answers you gave me makes perfect sense to me i just need to apply this to my situation (no sweat) TodD I haven't a clue what your talking about. But I think that is because of my in experience with vba.

Thanks

Noel

 

If Jackrabbit's makes sense to you, by all means do that. It's a much
better solution.

The vbCr is simply a carriage return. Think of typing two lines of TEXT
objects. You type the first, press enter, and the second is placed directly
under it. If you attach a vbCr to the beginning of a text string, you get
that effect, without the first line of text.

sTextString = vbCr & "My second line of text"

 

Thanks for the explanation it is actually a simpler rout to follow

 

You're quite welcome. I mentioned it because of it's simplicity.

Again, not to beat the dead horse, but the other posted solution is much
*better*, but if your needs are limited, I wouldn't bother.