Place mText with annotative scale via VBA

[hungkwunwah]

Hi,

How to enable annotative scale when placing leader with Mtext via VBA ?

Thank you!

Sub AddLeader(ptcenter As Variant, txtpoint As Variant, Noofdigit As Integer) 'place coordinate with leader
Dim points(0 To 5) As Double
Dim xText As String
Dim yText As String
Dim txtCoord As String
Dim leaderObj As AcadLeader
Dim MtextObj As AcadMText

xText = digit(ptcenter(0), Noofdigit)
yText = digit(ptcenter(1), Noofdigit)
txtCoord = xText & " E" & vbCrLf & yText & " N"
points(0) = ptcenter(0): points(1) = ptcenter(1): points(2) = ptcenter(2)
points(3) = txtpoint(0): points(4) = txtpoint(1): points(5) = txtpoint(2)


Set MtextObj = ThisDrawing.ModelSpace.AddMText(txtpoint, Len(txtCoord) * ThisDrawing.GetVariable("dimscale"), txtCoord)
Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, MtextObj, acLineWithArrow)
leaderObj.TextGap = 0
If ptcenter(0) < txtpoint(0) Then
 MtextObj.AttachmentPoint = acAttachmentPointMiddleLeft
Else
 MtextObj.AttachmentPoint = acAttachmentPointMiddleRight
End If
MtextObj.InsertionPoint = txtpoint
MtextObj.Rotation = 0
leaderObj.Update
End Sub

[Ed__Jobe]

You have to set it's StyleName property to a style that is defined as annotative.

Also, you may want to consider using an MLEADER. You can just set it's TextString property instead of creating an MTEXT.

[hungkwunwah]

Thanks for your help. I have tried to use Mleader. However when places the leader from left to Right. The Mtext always placed in right hand side.

Sub AddMLeader(ptcenter As Variant, txtpoint As Variant, Noofdigit As Integer) 'place coordinate with leader
Dim oML As AcadMLeader
Dim points(0 To 5) As Double
Dim xText As String
Dim yText As String
Dim txtCoord As String

xText = digit(ptcenter(0), Noofdigit)
yText = digit(ptcenter(1), Noofdigit)
txtCoord = xText & " E" & vbCrLf & yText & " N"
' Define the leader points
points(0) = ptcenter(0): points(1) = ptcenter(1): points(2) = ptcenter(2)
points(3) = txtpoint(0): points(4) = txtpoint(1): points(5) = txtpoint(2)

Set oML = ThisDrawing.ModelSpace.AddMLeader(points, 0)

oML.TextString = txtCoord 'show coordinate
oML.TextLeftAttachmentType = acAttachmentMiddle
oML.TextRightAttachmentType = acAttachmentMiddle

If ptcenter(0) > txtpoint(0) Then
  oML.TextJustify = acAttachmentPointMiddleRight
Else
   oML.TextJustify = acAttachmentPointMiddleLeft
End If
oML.Update
End Sub

[Ed__Jobe]

I would test it for you, but there is not enough info. Can you supply the missing digit() function as well as a sample sub that calls this one? When you post code, use the code button (</>) to preserve formatting.

[hungkwunwah]

Thanks for your help, I attached relative code for your reference.

Option Explicit

Public Sub placeCoord()
Dim ptcenter As Variant
Dim txtpoint As Variant
Dim Noofdigit As Integer


On Error Resume Next
ThisDrawing.Utility.InitializeUserInput 0
Noofdigit = ThisDrawing.Utility.GetInteger(vbCr & "No of digit 0-4 [3]")
If Noofdigit < 0 Or Noofdigit > 4 Then
Noofdigit = 3
End If
ptcenter = ThisDrawing.Utility.GetPoint(, vbCr & "Pick Point")
txtpoint = ThisDrawing.Utility.GetPoint(, vbCr & "Pick Text Point")


Call AddMLeader(ptcenter, txtpoint, Noofdigit)
'Call AddLeader(ptcenter, txtpoint, Noofdigit)

End Sub

Function digit(pt As Variant, Noofdigit As Integer) As String ' no of digit

digit = FormatNumber(Math.Round(pt + 0.000001, Noofdigit), Noofdigit, , , vbFalse)
End Function
Sub AddMLeader(ptcenter As Variant, txtpoint As Variant, Noofdigit As Integer) 'place coordinate with leader
Dim oML As AcadMLeader
Dim points(0 To 5) As Double
Dim xText As String
Dim yText As String
Dim txtCoord As String

xText = digit(ptcenter(0), Noofdigit)
yText = digit(ptcenter(1), Noofdigit)
txtCoord = xText & " E" & vbCrLf & yText & " N"
' Define the leader points
points(0) = ptcenter(0): points(1) = ptcenter(1): points(2) = ptcenter(2)
points(3) = txtpoint(0): points(4) = txtpoint(1): points(5) = txtpoint(2)

Set oML = ThisDrawing.ModelSpace.AddMLeader(points, 0)

oML.TextString = txtCoord 'show coordinate
oML.TextLeftAttachmentType = acAttachmentMiddle
oML.TextRightAttachmentType = acAttachmentMiddle

If ptcenter(0) > txtpoint(0) Then

oML.TextJustify = acAttachmentPointMiddleRight

'oML.TextDirection = acRightToLeft


Else
oML.TextJustify = acAttachmentPointMiddleLeft

End If

oML.Update
End Sub