Reference Column Sheet
You didn't ask any questions...
Your title block doesn't have any attributes. If it did, you could place a field in the attribute that links to the table block's Sheet_ field. No coding necessary. See attached file.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
That's a little clearer, but can you show your code?
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Accepted solution
This code works when there is only one title block. I'll let you figure out how to do it if there are multiple title blocks.
Public Sub SetTableText()
Dim ss As AcadSelectionSet
Dim oblk As AcadBlockReference
Dim oTblk As AcadBlockReference
Dim oAtt As AcadAttributeReference
Dim oAtts As Variant
Dim ip As Variant
Dim attSHEET As AcadAttributeReference
Dim N1s As String
Dim N2s As String
Dim N3s As String
Dim N4s As String
Dim attCol As AcadAttributeReference
Dim attSht As AcadAttributeReference
Dim i As Integer
Dim sht As String
Dim N1x As Double
Dim N2x As Double
Dim N3x As Double
Dim N4x As Double
'Get Title block values
Set ss = GetSS_BlockName("TITLE")
Set oTblk = ss(0)
If oTblk.HasAttributes Then
oAtts = oTblk.GetAttributes
For i = 0 To UBound(oAtts)
Select Case oAtts(i).TagString
Case Is = "SHEET"
sht = oAtts(i).TextString
Case Is = "ELEM_N1"
N1s = oAtts(i).TextString
'Get X value of InsertionPoint
ip = oAtts(i).InsertionPoint
N1x = ip(0)
Case Is = "ELEM_N2"
N2s = oAtts(i).TextString
ip = oAtts(i).InsertionPoint
N2x = ip(0)
Case Is = "ELEM_N3"
N3s = oAtts(i).TextString
ip = oAtts(i).InsertionPoint
N3x = ip(0)
Case Is = "ELEM_N4"
N4s = oAtts(i).TextString
ip = oAtts(i).InsertionPoint
N4x = ip(0)
End Select
Next i
Else
ThisDrawing.Utility.Prompt "\nNo Title block found."
Exit Sub
End If
'Process Table blocks
Set ss = GetSS_BlockName("TABLE")
If ss.Count > 0 Then
For Each oblk In ss
If oblk.HasAttributes Then
oAtts = oblk.GetAttributes
For i = 0 To UBound(oAtts)
If oAtts(i).TagString = "COLUM_" Then
Set attCol = oAtts(i)
'Set column property to correct column determined by block insertion point
Select Case attCol.InsertionPoint(0)
Case (N1x - 21) To (N1x + 21)
attCol.TextString = N1s
Case (N2x - 21) To (N2x + 21)
attCol.TextString = N2s
Case (N3x - 21) To (N3x + 21)
attCol.TextString = N3s
Case (N4x - 21) To (N4x + 21)
attCol.TextString = N4s
End Select
Else
'Set sheet number
oAtts(i).TextString = sht
End If
Next i
End If
oblk.Update
Next oblk
'ThisDrawing.Regen
Else
ThisDrawing.Utility.Prompt "\nNo Table blocks found."
End If
End Sub
Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for when you want to create a
' selectin set. It takes the proposed name and either adds it to the selectionsets
' collection or sets it.
On Error Resume Next
Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
If Err.Number <> 0 Then
Set AddSelectionSet = ThisDrawing.SelectionSets.item(SetName)
AddSelectionSet.Clear
End If
End Function
Public Function GetSS_BlockName(BlockName As String) As AcadSelectionSet
'creates a ss of blocks with the name supplied in the argument
Dim s2 As AcadSelectionSet
Set s2 = AddSelectionSet("ssBlocks") ' create ss with a name
s2.Clear ' clear the set
Dim intFtyp(1) As Integer ' setup for the filter
Dim varFval(1) As Variant
Dim varFilter1, varFilter2 As Variant
intFtyp(0) = 0: varFval(0) = "INSERT" ' get only blocks
intFtyp(1) = 2: varFval(1) = BlockName ' of this name
varFilter1 = intFtyp: varFilter2 = varFval
s2.Select acSelectionSetAll, , , varFilter1, varFilter2 ' do it
Set GetSS_BlockName = s2
End Function
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
Since my code answers your original question, you should be able to mark it as the solution.
Ed
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.
