What's wrong in code? Get Field Expression Tool

[danderson.71652]

I am very new to VB, and I know there may be better ways to do certain things, but I am learning.

I want a tool that will simply

I have come across a situation that works sometimes, and sometimes not, and I cannot figure out why?

I am including a test file dwg.

Thanks
Dan

VB Code

Sub GetFieldExpression()
Dim ssetObj As AcadSelectionSet
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim entText As AcadObject
Dim vPt As Variant
Dim text As String
Tag
On Error GoTo Err_Control

' Sub ???Not sure why TextObj needs to be present to work, delete after
Dim textObj As IAcadText2
Dim insertionPoint(0 To 2) As Double
Dim Height As Double
text = "%<\AcVar Date \f ""M/d/yyyy""%>%"
insertionPoint(0) = 2000000: insertionPoint(1) = 2000000: insertionPoint(2) = 0
Height = 0.5
Set textObj = ThisDrawing.ModelSpace.AddText(text, insertionPoint, Height)

'acSelectionSetLast
ThisDrawing.Application.ZoomAll
Set ssetObj = ThisDrawing.SelectionSets.Add("deletelast")
ssetObj.Select acSelectionSetLast
'MsgBox ("Selection set " & ssetObj.Name & " contains " & ssetObj.Count & " items")

text = textObj.FieldCode
UserForm3.Hide
ThisDrawing.Application.ZoomPrevious
ThisDrawing.Utility.GetEntity entText, vPt, vbCr & "Pick a FIELD in drawing:"
text = entText.FieldCode
UserForm3.TextBox1 = text
ThisDrawing.Application.ZoomAll

' Erase the objects in the selection set
ssetObj.Erase

ThisDrawing.Application.ZoomPrevious
UserForm3.Show
ThisDrawing.SelectionSets.Item("deletelast").Delete
Exit_Here:
Exit Sub
Err_Control:
MsgBox "This OBJECT FIELD Entity's Expression could not be found. " & vbCrLf & "Verify it is not inside a dimension or table.", vbOKOnly + vbQuestion, "CT-Error"
ssetObj.Erase
ThisDrawing.SelectionSets.Item("deletelast").Delete
Exit Sub
End Sub

[danderson.71652]

(Sorry, lost part of my sentence.....)
I want a tool that will simply tell the user the FIELD expression from the selected field from the user in a text box in a simple form. This way it could be cut/pasted if desired.

This is really a small piece of larger code, but I m trying to isolate this step first.
Thanks,
Dan

[danderson.71652]

still no ideas....?

[Ed Jobe]

Here is a heavily commented version of your code. Note that you can copy/paste the field code without this. When editing mtext, rt+clk on the field and select "Edit Field". Down at the bottom of the dialog is a selectable string.


Sub GetFieldExpression()
Dim ssetObj As AcadSelectionSet
Dim point1(0 To 2) As Double
Dim point2(0 To 2) As Double
Dim entText As AcadObject
Dim vPt As Variant
Dim text As String
' Tag 'ELJ: undefined, does what?
On Error GoTo Err_Control

' Sub ???Not sure why TextObj needs to be present to work, delete after
'ELJ: textObj is a programming object, not an acad entity. It is a variable that
'is a pointer to objects. Its interface exposes (provides) properties for
'you to manipulate. Perhaps you are confused about what the AddText method does.
'It adds an entity who's type is AcadText to the dwg and returns a pointer to that
'entiy to the calling procedure (the Set statement in this case).
'But since IAcadText2 is derived from AcadText, it is able to accept an entity
'of that type, but it adds additional properties not found in the AcadText object.
Dim textObj As IAcadText2
Dim mtextObj As IAcadMText2
Dim insertionPoint(0 To 2) As Double
Dim Height As Double
' text = "%<\AcVar Date \f ""M/d/yyyy""%>%"
' insertionPoint(0) = 2000000: insertionPoint(1) = 2000000: insertionPoint(2) = 0
' Height = 0.5
' Set textObj = ThisDrawing.ModelSpace.AddText(text, insertionPoint, Height)

'acSelectionSetLast
' ThisDrawing.Application.ZoomAll
' Set ssetObj = ThisDrawing.SelectionSets.Add("deletelast")
' ssetObj.Select acSelectionSetLast
'MsgBox ("Selection set " & ssetObj.Name & " contains " & ssetObj.Count & " items")

' text = textObj.FieldCode 'ELJ: moved to follow ent selection
' UserForm3.Hide
' ThisDrawing.Application.ZoomPrevious
ThisDrawing.Utility.GetEntity entText, vPt, vbCr & "Pick a FIELD in drawing:"
'ELJ: With GetEntity, you need to ensure that the picked object is the right type.
If TypeOf entText Is AcadText Then
Set textObj = entText
text = textObj.FieldCode
'now that the text var is set,
'your form can do something with it
MsgBox "The field code for the selected text is:" & vbCrLf & text
End If
If TypeOf entText Is AcadMText Then
Set mtextObj = entText
text = mtextObj.FieldCode
'now that the text var is set,
'your form can do something with it
MsgBox "The field code for the selected mtext is:" & vbCrLf & text
End If

' text = entText.FieldCode 'ELJ: entText is type Object and does not support this property
' UserForm3.TextBox1 = text
' ThisDrawing.Application.ZoomAll

' Erase the objects in the selection set
' ssetObj.Erase

' ThisDrawing.Application.ZoomPrevious
' UserForm3.Show
' ThisDrawing.SelectionSets.Item("deletelast").Delete
Exit_Here:
Exit Sub
Err_Control:
'This error logic assumes ANY error generated is of the same type.
MsgBox "This OBJECT FIELD Entity's Expression could not be found. " & vbCrLf & "Verify it is not inside a dimension or table.", vbOKOnly + vbQuestion, "CT-Error"
ssetObj.Erase
ThisDrawing.SelectionSets.Item("deletelast").Delete
Exit Sub
End Sub

[danderson.71652]

Thank you very much for your response. I will review it, and and tryout your solution. Thanks again for your help.

Dan