topic help in VBA Forum

help

Anonymous — Sat, 01 Mar 2008 15:48:29 GMT

I need to be able to place text in Autocad while controlling the angle and justification. And I am havig trouble doing both. I have known coordinates to place the text. Can someone show me an example?

Re: help

Anonymous — Sun, 02 Mar 2008 12:32:37 GMT

This will label mtext 100 & 102 at the selected screen points with the
rotation of the axis from pnt & pnt2

hope this helps

John

Sub labeltext()
Dim pt1 As Variant
Dim Pt2 As Variant
Dim Leftendelevation As Double
Dim Rightendelevation As Double
Dim mtxtlabel As AcadMText
Dim dblrot As Double

pt1 = ThisDrawing.Utility.GetPoint(, "PICK FIRST RUNWAY END: LEFT TO RIGHT
")
' Get the value
Leftendelevation = 100#

Pt2 = ThisDrawing.Utility.GetPoint(pt1, "PICK SECOND RUNWAY END: ")
' Get the station
Rightendelevation = 102#

dblrot = ThisDrawing.Utility.AngleFromXAxis(pt1, Pt2)
Set mtxtlabel = ThisDrawing.ModelSpace.AddMText(pt1, dblWidth,
Leftendelevation)
mtxtlabel.Height = 5
mtxtlabel.Rotation = dblrot

Set mtxtlabel = ThisDrawing.ModelSpace.AddMText(Pt2, dblWidth,
Rightendelevation)
mtxtlabel.Height = 5
mtxtlabel.Rotation = dblrot
End Sub

wrote in message
news:5863525@discussion.autodesk.com...
I need to be able to place text in Autocad while controlling the angle and
justification. And I am havig trouble doing both. I have known coordinates
to place the text. Can someone show me an example?

Re: help

Anonymous — Sun, 02 Mar 2008 15:47:00 GMT

To continue the prior thread
Here is the same method for plain text:

Sub AlignText()
Dim sset As AcadSelectionSet
Dim dxfCode, dxfValue
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "LINE"
dxfCode = ftype: dxfValue = fdata
Dim lineObj As Object
Dim oText As AcadText
Dim oEnt As AcadEntity
Dim strText1 As String
Dim strText2 As String
Dim txtPt As Variant
Dim movePt1 As Variant
Dim movePt2 As Variant
Dim dblHgt As Double
Dim dblAng As Double
Dim moveAng As Double
Dim rotAng As Double
Dim PI As Double
PI = Atn(1) * 4

' Define the new Text object
strText1 = "First line"
strText2 = "Second line"
dblHgt = 0.125

With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
End With

Set sset = ThisDrawing.SelectionSets.Add("$Lines$")
sset.SelectOnScreen dxfCode, dxfValue
For Each oEnt In sset
' get the line object
Set lineObj = oEnt
txtPt = lineObj.StartPoint

' get line angle
dblAng = lineObj.Angle
' Debug.Print dblAng ' debug only
' recalculate rotation angle
If dblAng >= 0 Then
rotAng = dblAng
End If

If dblAng > PI / 2 Then
rotAng = PI + dblAng
End If

If dblAng >= PI * 1.5 Then
rotAng = dblAng
End If

If dblAng >= PI * 1.5 And dblAng <= PI * 2 _
Or dblAng <= PI / 2 And dblAng >= 0 Then
moveAng = dblAng + PI / 2
Else
moveAng = dblAng - PI / 2
End If

' Debug.Print rotAng ' debug only
' update text object
movePt1 = ThisDrawing.Utility.PolarPoint(txtPt, moveAng, 0.25 * dblHgt) '< --0.25 * dblHgt is text offset change to suit
' Create the Text object in model space
Set oText = ThisDrawing.ModelSpace.AddText(strText1, movePt1, dblHgt)

oText.Alignment = acAlignmentBottomCenter
oText.TextAlignmentPoint = movePt1
oText.Rotation = rotAng
movePt2 = ThisDrawing.Utility.PolarPoint(txtPt, moveAng + PI, 0.25 * dblHgt) '< --0.25 * dblHgt is text offset change to suit
' Create the Text object in model space
Set oText = ThisDrawing.ModelSpace.AddText(strText2, movePt2, dblHgt)
oText.Alignment = acAlignmentTopCenter
oText.TextAlignmentPoint = movePt2
oText.Rotation = rotAng

Next oEnt

End Sub

~'J'~