Option Explicit
Sub DoDataSheets()
' 7 May 2019. Table are being read and the invisibility states of all the objects may be changed
' 8 May 2019. VBA Reads all data from NAGspecification. NAGspecification re-written.
' Two new tables: text1 and text2
' 9 May 2019. Changing $ variables into text. Working
'10 May 2019. Template 1 updating. Text stuff needs to be proof read. Next bit is to template 2.
'14 May 2019. Template 2 working. Blocks have visibility states completed.
'Declare the Global Variables
Const numberOfTemplates = 4
Const numberOfEntities = 100
Const issueDate = "7 May 2019"
' Declare the templates
Dim template As AcadLayout
' Declare the tables
Dim tableArray() As AcadTable
ReDim tableArray(numberOfEntities)
' Declare the blocks
Dim props() As AcadDynamicBlockReferenceProperty
Dim prop As AcadDynamicBlockReferenceProperty
Dim blkref As AcadBlockReference
' Declare Entities
Dim entity As AcadEntity
' Declare Index's
Dim tableIndex, NAGspecificationTableIndex As Integer
Dim loadCondition1Index, loadCondition2Index, loadCondition3Index As Integer
Dim technicalDataSheetIndex, safeSpanTablesIndex, propertiesIndex, certificationIndex, disclaimerIndex As Integer
Dim page1Index, page2Index, text1Index, text2Index As Integer
'Locate and Assign the Tables
' Loop through the templates
tableIndex = 1
For Each template In ThisDrawing.Layouts
' Loop through each entity
For Each entity In template.Block
' Identify the table and assign to tableArray
If TypeOf entity Is AcadTable Then
'Stop
Set tableArray(tableIndex) = entity
'Debug.Print tableArray(tableIndex).GetCellValue(0, 0)
'Identify the NAGspecification table
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Technical Data Sheet}" Then technicalDataSheetIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Safe Span Tables}" Then safeSpanTablesIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Load Condition 1}" Then loadCondition1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C0;Load Condition 2}" Then loadCondition2Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C0;Load Condition 3}" Then loadCondition3Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Properties}" Then propertiesIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Certification}" Then certificationIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "{\C256;Disclaimer}" Then disclaimerIndex = tableIndex
If tableArray(tableIndex).GetCellValue(0, 2) = "Page 1" Then page1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 2) = "Page 2" Then page2Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "text1" Then text1Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "text2" Then text2Index = tableIndex
If tableArray(tableIndex).GetCellValue(0, 0) = "NAGspecification" Then NAGspecificationTableIndex = tableIndex
tableIndex = tableIndex + 1
End If
Next entity
Next template
'Get the DataSheet values
Dim productReference, textTable, blockVisibility As String
Dim numberProductReferences, rowIndex, i As Integer
Dim ld1(2), ld2(2), ld3(2) As String
Dim lc1(2), lc2(2), lc3(2) As String
Dim lctxt1(2), lctxt2(2), lctxt3(2) As String
Dim loadtype As String
Dim u, light As String
Dim sw As Integer
Dim d1, d2, d3, d4, d5, d6, d7 As String
Dim p1, p2, p3, p4, p5, p6, p7 As String
'Stop
numberProductReferences = tableArray(NAGspecificationTableIndex).Rows - 4
For rowIndex = 4 To numberProductReferences + 3
With tableArray(NAGspecificationTableIndex)
' Stop
productReference = .GetCellValue(rowIndex, 0)
loadtype = .GetCellValue(rowIndex, 1)
If loadtype = 1 Then
lctxt1(0) = "Domestic and Residential Activities"
lctxt1(1) = "All usage within self-contained dwelling units including student-accommodation, blocks of flats, dormitories, hotels, motels, hospitals, public-toilets, snooker-rooms, balconies., flat-roofs and walkways. Not suitable for where people may congregate."
lctxt2(0) = "Communal Areas"
lctxt2(1) = "Areas where people may congregate including restaurants, reading-rooms, classrooms, fixed seating areas, corridors, museums, dance floors, concert halls and public areas subject to crowding."
lctxt3(0) = "Highway Use"
lctxt3(1) = "Pavement-lights situated close to a road or access where heavy vehicles could park on the pavement-light. Inner London requirement."
lc1(0) = .GetCellValue(rowIndex, 4): lc1(1) = .GetCellValue(rowIndex, 5)
lc2(0) = .GetCellValue(rowIndex, 6): lc2(1) = .GetCellValue(rowIndex, 7)
lc3(0) = .GetCellValue(rowIndex, 8): lc3(1) = .GetCellValue(rowIndex, 9)
ld1(0) = .GetCellValue(3, 4): ld1(1) = .GetCellValue(3, 5)
ld2(0) = .GetCellValue(3, 6): ld2(1) = .GetCellValue(3, 7)
ld3(0) = .GetCellValue(3, 8): ld1(1) = .GetCellValue(3, 9)
End If
If loadtype = 2 Then
lctxt1(0) = "Rooflights and Domestic Use"
lctxt1(1) = "."
lctxt2(0) = "Domestic and Residential Activities"
lctxt2(1) = "All usage within self-contained dwelling units including student-accommodation, blocks of flats, dormitories, hotels, motels, hospitals, public-toilets, snooker-rooms, balconies., flat-roofs and walkways. Not suitable for where people may congregate."
lctxt3(0) = "Communal Areas"
lctxt3(1) = "Areas where people may congregate including communal restaurants, reading-rooms, classrooms, fixed seating areas, assembly areas, corridors, museums, dance floors, concert halls and public areas subject to crowding."
lc1(0) = .GetCellValue(rowIndex, 2): lc1(1) = .GetCellValue(rowIndex, 3)
lc2(0) = .GetCellValue(rowIndex, 4): lc2(1) = .GetCellValue(rowIndex, 5)
lc3(0) = .GetCellValue(rowIndex, 6): lc3(1) = .GetCellValue(rowIndex, 7)
ld1(0) = .GetCellValue(3, 4): ld1(1) = .GetCellValue(3, 5)
ld2(0) = .GetCellValue(3, 6): ld2(1) = .GetCellValue(3, 7)
ld3(0) = .GetCellValue(3, 8): ld1(1) = .GetCellValue(3, 9)
End If
textTable = .GetCellValue(rowIndex, 10)
blockVisibility = .GetCellValue(rowIndex, 11)
d1 = productReference
d2 = .GetCellValue(rowIndex, 12)
d3 = .GetCellValue(rowIndex, 13)
d4 = .GetCellValue(rowIndex, 14)
d5 = .GetCellValue(rowIndex, 15)
d6 = .GetCellValue(rowIndex, 16)
d7 = .GetCellValue(rowIndex, 17)
u = .GetCellValue(rowIndex, 18)
sw = .GetCellValue(rowIndex, 19)
light = .GetCellValue(rowIndex, 20)
'Stop
End With ' tableArray(NAGspecificationTableIndex)
'Time to get the text box values
If textTable = "text1" Then
With tableArray(text1Index)
p1 = DoDollar(.GetCellValue(2, 1), d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(.GetCellValue(2, 2), d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(.GetCellValue(2, 3), d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(.GetCellValue(3, 1), d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(.GetCellValue(4, 1), d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(.GetCellValue(4, 2), d1, d2, d3, d4, d5, d6, d7)
' Do again for included $'s
p1 = DoDollar(p1, d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(p2, d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(p3, d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(p4, d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(p5, d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(p6, d1, d2, d3, d4, d5, d6, d7)
End With 'tableArray(text1Index)
End If 'textTable = "text1"
If textTable = "text2" Then
With tableArray(text2Index)
p1 = DoDollar(.GetCellValue(2, 1), d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(.GetCellValue(2, 2), d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(.GetCellValue(2, 3), d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(.GetCellValue(3, 1), d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(.GetCellValue(4, 1), d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(.GetCellValue(4, 2), d1, d2, d3, d4, d5, d6, d7)
' Do again for included $'s
p1 = DoDollar(p1, d1, d2, d3, d4, d5, d6, d7)
p2 = DoDollar(p2, d1, d2, d3, d4, d5, d6, d7)
p3 = DoDollar(p3, d1, d2, d3, d4, d5, d6, d7)
p4 = DoDollar(p4, d1, d2, d3, d4, d5, d6, d7)
p5 = DoDollar(p5, d1, d2, d3, d4, d5, d6, d7)
p6 = DoDollar(p6, d1, d2, d3, d4, d5, d6, d7)
End With 'tableArray(text2Index)
End If 'textTable = "text2"
'Write to Templates
'Set the Product Reference
With tableArray(technicalDataSheetIndex)
Call .SetValue(0, 1, 0, d1)
Call .SetValue(3, 0, 0, p1)
Call .SetValue(3, 1, 0, p2)
Call .SetValue(3, 2, 0, p3)
End With
Call tableArray(safeSpanTablesIndex).SetValue(1, 0, 0, p4)
With tableArray(loadCondition1Index)
Call .SetValue(0, 3, 0, lctxt1(0))
Call .SetValue(1, 0, 0, lctxt1(1))
Call .SetValue(3, 0, 0, ld1(0))
Call .SetValue(3, 1, 0, ld1(1))
Call .SetValue(3, 2, 0, lc1(0) & " mm")
Call .SetValue(3, 3, 0, lc1(1) & " mm")
End With
With tableArray(loadCondition2Index)
Call .SetValue(0, 3, 0, lctxt2(0))
Call .SetValue(1, 0, 0, lctxt2(1))
Call .SetValue(3, 0, 0, ld2(0))
Call .SetValue(3, 1, 0, ld2(1))
Call .SetValue(3, 2, 0, lc2(0) & " mm")
Call .SetValue(3, 3, 0, lc2(1) & " mm")
End With
With tableArray(loadCondition3Index)
Call .SetValue(0, 3, 0, lctxt3(0))
Call .SetValue(1, 0, 0, lctxt3(1))
Call .SetValue(3, 0, 0, ld2(0))
Call .SetValue(3, 1, 0, ld2(1))
Call .SetValue(3, 2, 0, lc2(0) & " mm")
Call .SetValue(3, 3, 0, lc2(1) & " mm")
End With
With tableArray(propertiesIndex)
Call .SetValue(1, 1, 0, p5)
Call .SetValue(1, 2, 0, p6)
Call .SetValue(2, 1, 0, uValue(u))
Call .SetValue(3, 1, 0, selfWeight(sw))
Call .SetValue(4, 1, 0, lightTransmittance(light))
End With
'Locate and Assign the Block visibilities
' Loop through the templates
For Each template In ThisDrawing.Layouts
' Loop through each entity
For Each entity In template.Block
' Identify the block visibility and assign the visibility value
If TypeOf entity Is AcadBlockReference Then
Set blkref = entity
If blkref.IsDynamicBlock Then
props = blkref.GetDynamicBlockProperties
For i = 0 To UBound(props)
Set prop = props(i)
'Debug.Print prop.PropertyName
If prop.PropertyName = "Visibility1" Then
prop.Value = blockVisibility
End If
If prop.PropertyName = "Plans" Then
prop.Value = productReference
End If
Next i
End If
End If
Next entity
Next template
ThisDrawing.Application.Update
Next rowIndex
Stop
MsgBox "Done"
'
End Sub
Function DoColon(txt As String) As String
'Stop
Dim strLen, i As Integer
strLen = Len(txt)
For i = 1 To strLen
' Find the semi-colon
If Mid(txt, i, 1) = ";" Then
DoColon = Right(txt, strLen - i)
Exit For
End If
Next i
End Function
Function DoDollar(txt, d1, d2, d3, d4, d5, d6, d7) As String 'txt, d1, d2, d3, d4, d5, d6 As String) As String
txt = Replace(txt, "$1", d1)
txt = Replace(txt, "$2", d2)
txt = Replace(txt, "$3", d3)
txt = Replace(txt, "$4", d4)
txt = Replace(txt, "$5", d5)
txt = Replace(txt, "$6", d6)
txt = Replace(txt, "$7", d7)
DoDollar = txt
'Debug.Print DoDollar
'Stop
End Function
Function selfWeight(n) As String
selfWeight = Format(CStr(n * 0.981), "000.0") & " kN/sq.m" & " (" & CStr(n) & " kg/sq.m )"
End Function
Function uValue(n) As String
uValue = n & " W/sq.m.K"
End Function
Function lightTransmittance(n) As String
If n = "N/A" Then lightTransmittance = n Else lightTransmittance = n & " %"
End Function