Архитектура и дизайн / Ведомость отделки - Revit 2016 - Roombook Extension  

Хочу сказать несколько слов за такое приложение к Revit как Roombook Extension. Это приложение помогает рассчитать отделку. Но оно как известно имеет несколько недостатков:

1. Не выдает таблицу ведомости отделки по ГОСТу, в данных которые экспортируются в Excel сложно разобраться
2. Из длины плинтусов не вычитается длина проемов дверей, выдается просто периметр помещений.
3. Кроме того не забывайте подвесные потолки делать перекрытиями, а не потолками - Roombook иногда не принимает потолок как ограничение по высоте для отделки, а перекрытие всегда служит границей отделки

Я написал скрипт Excel, который отчасти решает эти проблемы.

Кидаю VBA скрипт для Excel, которые выкидывает из длины плинтусов длину дверей и формирует вкладку - Ведомость помещений - привычного ГОСТовского вида. Применять скрипт надо на файл Roombook_Russian_Standard_SPDS который выдает при экспорте Roombook. Работает только для 2016 версии Revit

1. Определяем сначала класс:

Public Number As String
Public Name As String
Public Wall As String
Public Area As Double
Public NameSection As String
Public NameElement As String
Public DoorLenght As Double
Public AllKirpich1 As Double
Public AllKirpich2 As Double
Public Pl As String
Public PlLenght As Double
Public Sub clsFinishing_Initialize()
End Sub
2. Теперь самая мякотка - скрипт:
Sub Make_finishing_Roombook()
'
' Make_finishing_Roombook Макрос
'
'
Application.ScreenUpdating = 0
Dim vedName As String
vedName = InputBox("Введите название ведомости", "Запрос параметра", "")
'Добавим лист с ведомостью отделки
Worksheets.Add.Name = "Ведомость отделки"
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
' Добавим необходимые ячейки
ActiveSheet.Range("B2").Value = vedName
Application.DisplayAlerts = False
ActiveSheet.Range("B2:G2").Merge
Application.DisplayAlerts = True
ActiveSheet.Range("B3").Value = "№ п/п"
ActiveSheet.Columns("B").ColumnWidth = 10
ActiveSheet.Range("C3").Value = "Имя помещения"
ActiveSheet.Columns("C").ColumnWidth = 30
ActiveSheet.Range("D3").Value = "Стены, колонны или перегородки"
ActiveSheet.Columns("D").ColumnWidth = 30
ActiveSheet.Range("E3").Value = "Площадь стен, м.кв."
ActiveSheet.Columns("E").ColumnWidth = 15
ActiveSheet.Range("F3").Value = "Низ стены, м.п."
ActiveSheet.Columns("F").ColumnWidth = 30
ActiveSheet.Range("G3").Value = "Длина м.п."
ActiveSheet.Columns("G").ColumnWidth = 15
ActiveSheet.Rows(2).RowHeight = 30
ActiveSheet.Rows(3).RowHeight = 30
'Делаем объект Отделка
Dim Finish As clsFinishing
Set Finish = New clsFinishing
'Разбираемся с плинтусом
Dim index As Integer
Dim indexVO As Integer
Dim continue As Boolean
continue = True
index = 15
indexVO = 4
Sheets("Периметры_помещений").Select
Finish.Number = Range("A" & CStr(index))
Finish.Name = Range("B" & CStr(index))
Do While continue = True
index = index + 1
Sheets("Периметры_помещений").Select
If IsEmpty(Range("A" & CStr(index))) = False Then
Set PlTemp = Range("H" & CStr(index - 1))
Finish.Pl = Range("F" & CStr(index - 2))
Sheets("Ведомость отделки").Select
Range("B" & CStr(indexVO)) = Finish.Number
Range("C" & CStr(indexVO)) = Finish.Name
Range("F" & CStr(indexVO)) = Finish.Pl
Range("G" & CStr(indexVO)) = PlTemp
Sheets("Периметры_помещений").Select
indexVO = indexVO + 1
Finish.Number = Range("A" & CStr(index))
Finish.Name = Range("B" & CStr(index))
End If
If Range("A" & CStr(index)) = "Всего" Then
continue = False
End If
Loop
'Отнимаем от плинтуса длину дверей
Sheets("Поверхность_стен").Select
Finish.Number = Range("A" & CStr(index))
Finish.NameSection = Range("E" & CStr(index))
Finish.PlLenght = 0
Finish.DoorLenght = 0
Dim addDoor As Boolean
continue = True
addDoor = False
index = 15
indexVO = 4
Do While continue = True
Finish.NameSection = Range("E" & CStr(index))
addDoor = True
If Finish.NameSection = "Главная" Then
addDoor = False
End If
If addDoor = True Then
Finish.DoorLenght = Finish.DoorLenght + Range("L" & CStr(index))
End If
If IsEmpty(Range("A" & CStr(index + 1))) = False Then
Sheets("Ведомость отделки").Select
Range("G" & CStr(indexVO)) = (Range("G" & CStr(indexVO)) - Finish.DoorLenght) / 1000
Finish.DoorLenght = 0
indexVO = indexVO + 1
End If
Sheets("Поверхность_стен").Select
index = index + 1
If Range("A" & CStr(index)) = "Всего" Then
continue = False
End If
Loop
Sheets("Ведомость отделки").Select
'Добиваем отделку стен и площадь
Sheets("все_величины_помещения").Select
continue = True
index = 16
indexVO = 4
Finish.Wall = Range("C" & CStr(index))
Finish.Area = Range("D" & CStr(index))
Do While continue = True
If IsEmpty(Range("A" & CStr(index))) = False Then
Sheets("Ведомость отделки").Select
Range("D" & CStr(indexVO)) = Finish.Wall
Range("E" & CStr(indexVO)) = Finish.Area
indexVO = indexVO + 1
End If
index = index + 1
Sheets("все_величины_помещения").Select
Finish.Wall = Range("C" & CStr(index))
Finish.Area = Range("D" & CStr(index))
If Range("A" & CStr(index)) = "Всего по помещениям" Then
continue = False
End If
Loop
'Считаем количество штукатурки
Sheets("Поверхность_стен").Select
Finish.AllKirpich1 = 0
Finish.AllKirpich2 = 0
continue = True
index = 15
Do While continue = True
If IsEmpty(Range("C" & CStr(index))) = False Then
Finish.NameElement = Range("C" & CStr(index))
End If
If Finish.NameElement = "Кирпич" Then
If Range("E" & CStr(index)) = "Главная" Then
If Range("J" & CStr(index)) = "_Высококачественная гипс. штукатурка шпатлевка и окраска" Then
Finish.AllKirpich1 = Finish.AllKirpich1 + Range("N" & CStr(index))
End If
End If
End If
If Finish.NameElement = "Кирпич" Then
If Range("E" & CStr(index)) = "Главная" Then
If Range("J" & CStr(index)) = "_Улучшенная ц.п. штукатурка шпатлевка и окраска" Then
Finish.AllKirpich2 = Finish.AllKirpich2 + Range("N" & CStr(index))
End If
End If
End If
If Range("E" & CStr(index)) = "Главная" Then
Finish.Area = Finish.Area + Range("N" & CStr(index))
End If

index = index + 1
If Range("A" & CStr(index)) = "Всего" Then
continue = False
End If
Loop
'Удаляем плинтус где его нет
Sheets("Ведомость отделки").Select
continue = True
index = 4
Do While continue = True
If Range("F" & CStr(index)) = "_Отделка_нет_плинтуса" Then
Range("F" & CStr(index)) = "-"
Range("G" & CStr(index)) = "-"
End If
index = index + 1
If IsEmpty(Range("B" & CStr(index))) = True Then
Range("B" & CStr(index)) = "Примечание для ведомости:"
'Dim a As Integer
'a = Finish.AllKirpich
Range("B" & CStr(index + 1)) = "1. Высококачественная штукатурка на гипсовой основе 'Rotbond' толщиной до 20мм кирпичных стен по сетке без устройства каркаса, с предварительным покрытием поверхностей грунтовкой глубокого проникновения, площадь - " & CStr(CInt(Finish.AllKirpich1)) & "м.кв."
Range("B" & CStr(index + 2)) = "2. Цементно-песчаная штукатурка толщиной до 20мм кирпичных стен по сетке без устройства каркаса, с предварительным покрытием поверхностей грунтовкой глубокого проникновения, площадь - " & CStr(CInt(Finish.AllKirpich2)) & "м.кв."
Application.DisplayAlerts = False
Application.DisplayAlerts = True
continue = False
End If
Loop
'Ровняем ячейки
Sheets("Ведомость отделки").Select
Cells.Select
With Selection.Font
.Name = "ISOCPEUR"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "ISOCPEUR"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("E:E,G:G").Select
Range("G1").Activate
Selection.NumberFormat = "0.00"
Rows("2:3").Select
Range("A3").Activate
Selection.Font.Bold = True
Application.ScreenUpdating = 1
End Sub
3. Вот как результат выглядит



Известные проблемы скрипта. Если у Вас в помещениях есть витражи, сделанные стенами - площадь витражей не вычитается из площади отделки. Ну и кроме того для сложных типов помещений и отделки нужно проверять работу скрипта, возможно потребуется его доработка.

неплохо, есть кто нить кто сможет протестить?

Кстати еще нашел проблему - длина окон отнимается от длины плинтусов, что конечно же неприятно. В общем если тема будет интересна, в будущем выложу доработанный скрипт.

Очень даже интересная тема!

Да, хотелось бы увидеть продолжение темы.

Поддержу тему. Расчет ведомости отделки в Excel для меня уже неактуален, так как код VBA совсем нечитабельный и сложный получается. Уже готов модуль для Dynamo который отделку, получаемую от Roombook систематизирует и отправляет в свойства помещений Revita. Остается только сделать Ведомость помещений с нужными полями и отделка готова. К сожалению прямо сейчас не могу выложить данный модуль, так как его надо привести в опрятный вид, на это пока нету времени. Будет время - напишу об этом подробнее.

Только не забудьте)

Похоже забыл =)

Добрый день. Много воды утекло с тех пор как я создал эту тему и сейчас мне отделка в Ревите неинтересна. Есть рабочие решения в Динамо, можете погуглить их, они даже на Ютуб есть. Есть краска в Ревите, есть детали, хватает способов посчитать отделку. Если хотите узнать, что я еще делаю для Ревит и скачать мои приложения для Ревит - заходите на мой блог по программированию в Ревит - http://bim3d.ru/blog/

Добрый день! Спасибо за выложенные решение проблемы, вполне возможно , что пригодится в будущем.

🫵 А ВЫ прислали письма для Архива разъяснений стройотрасли?!
Ждем ваших писем-разъяснений от МАиС, Стройтехнорм, Экспертизы, МЧС, БСЦ, РНТЦ и т.д. для наполнения  разрабатываемого Архива писем-разъяснений стройотрасли.