VBA - Link between Table/Text and Text/Text
I am not sure I understand what you mean by "command line (VBA)...". command line is where user enter commands/macros to let AutoCAD do something, while VBA is where people write VBA code, which can be executed as macro.
Field seems to be the thing you could use as what you expressed as "connection", which is literally MText with link(s) to data in the drawing (other entity, including text). Yes, Field can be created via VBA code, if that is what you want to know.
Excuse me norman.yuan,you are right.
I put also a screenshot to explain better what i want.
I want to know the VBA to create a field with a object to have the same text with VBA
and the VBA to create a table where the cells are the field with another objects.
[If it is possible also some examples].
The screenshots shows what i want.
Thank you very much in advance.
Francesco
In order to create Text as field, you need to know the field code to link the text string to different values froom the other (linked) entity. You can see "Field Exproession" at the bottom of the "Field" dialog box. For example, in the case liking a text entity to another text entity's TextString, the code is
"%<\AcObjProp Object(%<\_ObjId 1094833920>%).TextString>%", where the "ObjId" number needs to be replaces dynamically in the VBA code.
To create an AcadText as field, see VBA document's example. You can open VBA Editor in AutoCAD, open Object Browser, find AcadText on the left and find FieldCode() method on the right, click "?" button on top to open VBA document's code example. Here is quoted in the document:
Sub Example_FieldCode()
' This example creates a text object in model space.
' It then returns the field code string for the object.
Dim textObj As AcadText
Dim text As String
Dim insertionPoint(0 To 2) As Double
Dim height As Double
' Define the text object
text = "%<\AcVar Date \f ""M/d/yyyy""%>%"
insertionPoint(0) = 2: insertionPoint(1) = 2: insertionPoint(2) = 0
height = 0.5
' Create the text object in model space
Set textObj = ThisDrawing.ModelSpace.AddText(text, insertionPoint, height)
ZoomAll
' Return the current text string for the object
text = textObj.FieldCode
MsgBox "The FieldCode for the text object equals: " & text, vbInformation, "FieldCode Example"
End Sub
Here is code sample I wrote, which ask user to select an existing Text entity (to be lined to), and then create a new Text entity that links to the previously selected text entity:
Private Const TEXT_STRING_FIELD_CODE As String = _
"%<\AcObjProp Object(%<\_ObjId ?>%).TextString>%"
Public Sub CreateLinkedText()
Dim txtEnt As AcadText
Set txtEnt = SelectTextEntity()
If txtEnt Is Nothing Then Exit Sub
Dim code As String
code = Replace(TEXT_STRING_FIELD_CODE, "?", CStr(txtEnt.ObjectID))
Dim insertionPt As Variant
insertionPt = PickPoint()
If VarType(insertionPt) = vbEmpty Then Exit Sub
Dim txt As AcadEntity
Set txt = ThisDrawing.ModelSpace.AddText(code, insertionPt, 1#)
txt.Update
ThisDrawing.Application.ZoomExtents
End Sub
Private Function SelectTextEntity() As AcadText
Dim ent As AcadEntity
Dim pt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a Text entity to link:"
If Not ent Is Nothing Then
If TypeOf ent Is AcadText Then
Set SelectTextEntity = ent
Exit Function
End If
End If
ThisDrawing.Utility.Prompt vbCr & "Invalid/cancelled picking." & vbCr
Set SelectTextEntity = Nothing
End Function
Private Function PickPoint() As Variant
Dim pt As Variant
On Error Resume Next
pt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick linked text location:")
PickPoint = pt
End Function
As for linking Table cells to other existing text entities, you would do
1. For each table cell, identify text entity to be linked. (user picking, or based on its layer, location, text string...);
2. Once the target text is identified, compose the link code (similar as I did: replace "?" in the string constant with target text's ObjectId value);
3. Create cell content as a text as the sample code showed here (or as MText, which can be set to entirely as field, or portion of it as field)
Accepted solution
OK, here is the sample code to link table's cells to text entities. It works in this way:
1. The code ask user to select a target table the code works against;
2. Then the code ask user to pick a cell in the table, which would be the first cell to be linked to text entity. Then the code starts a loop (to set each cell in next row of the same column;
3. For each cell to be linked, the code ask user to select a text entity. Once selected, its ObjectId value would be used in the FieldCode to create text in the table sell.
4. To create a Text entity in table cell is really simple by calling AcadTable.SetText(row, column, TextString). If the text string passed in is FieldCode, the text entity ccreated in the cell will be a Field.
Option Explicit
Private Const TEXT_STRING_FIELD_CODE As String = _
"%<\AcObjProp Object(%<\_ObjId ?>%).TextString>%"
Public Sub LinkTextToTable()
Dim tbl As AcadTable
Set tbl = GetTargetTable()
On Error Resume Next
tbl.Highlight True
Dim row As Long
Dim column As Long
Dim i As Long
Dim count As Integer
Dim linkCode As String
SelectFirstLinkedCell tbl, row, column
''MsgBox "First first linked cell is Cell(" & row & "," & column & ")"
If row >= 1 And column >= 1 Then
For i = row To tbl.Rows - 1
''MsgBox "Link Cell(" & i & "," & column & ")"
linkCode = GetLinkCodeFromTextEntity()
If linkCode = vbNullString Then Exit For
''MsgBox "Linked to: " + linkCode
AddLinkedTextToTable tbl, i, column, linkCode
count = count + 1
Next
End If
tbl.Highlight False
MsgBox count & " cells linked to text entities"
End Sub
Private Function GetTargetTable() As AcadTable
Dim ent As AcadEntity
Dim pt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select target table:"
If Not ent Is Nothing Then
If TypeOf ent Is AcadTable Then
Set GetTargetTable = ent
Exit Function
End If
End If
Set GetTargetTable = Nothing
End Function
Private Sub SelectFirstLinkedCell(table As AcadTable, row As Long, column As Long)
row = 0
column = 0
Dim pt As Variant
Dim zVector(0 To 2) As Double
On Error Resume Next
pt = ThisDrawing.Utility.GetPoint(, vbCr & _
"Pick a point inside the first cell to be linked to a text entity:")
On Error GoTo 0
If VarType(pt) <> vbEmpty Then
zVector(0) = 0#
zVector(1) = 0#
zVector(2) = 1#
table.HitTest pt, zVector, row, column
End If
End Sub
Private Function GetLinkCodeFromTextEntity() As String
Dim ent As AcadEntity
Dim pt As Variant
Dim txt As AcadText
Dim code As String
On Error Resume Next
ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select linked text:"
If Not ent Is Nothing Then
If TypeOf ent Is AcadText Then
code = Replace(TEXT_STRING_FIELD_CODE, "?", ent.ObjectID)
End If
End If
GetLinkCodeFromTextEntity = code
End Function
Private Sub AddLinkedTextToTable( _
table As AcadTable, row As Long, column As Long, linkCode As String)
table.SetText row, column, linkCode
table.Update
End Sub
Following video clip is attached to show how the code works.
Hope this helps
