cellpadding='0' cellspacing='0' border='0' > Войти или зарегистрироваться на Proekt.by  cellpadding="2" cellspacing="0" >
выберите раздел

""

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

 
Alefar ОФЛАЙН, открыть меню «Личное сообщение»     - Специалист   - Специалист
Репутация: 3  [+] , сообщений: 52 ,  BIM3D, http://bim3d.ru - Программирование под Revit, cтаж: 14 лет Belarus
09 Марта 2016
Хочу сказать несколько слов за такое приложение к 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. Вот как результат выглядит



Известные проблемы скрипта. Если у Вас в помещениях есть витражи, сделанные стенами - площадь витражей не вычитается из площади отделки. Ну и кроме того для сложных типов помещений и отделки нужно проверять работу скрипта, возможно потребуется его доработка.
Pew ОФЛАЙН, открыть меню «Личное сообщение»     - Специалист   - Специалист
Репутация: 1  [+] , сообщений: 78 ,  Belarus
09 Марта 2016
неплохо, есть кто нить кто сможет протестить?
Alefar ОФЛАЙН, открыть меню «Личное сообщение»     - Специалист   - Специалист
Репутация: 3  [+] , сообщений: 52 ,  BIM3D, http://bim3d.ru - Программирование под Revit, cтаж: 14 лет Belarus
09 Марта 2016
Кстати еще нашел проблему - длина окон отнимается от длины плинтусов, что конечно же неприятно. В общем если тема будет интересна, в будущем выложу доработанный скрипт.
NG ОФЛАЙН, открыть меню «Личное сообщение»     - Любитель
Репутация: 0  [+] , сообщений: 2 ,  Belarus
14 Марта 2016
Очень даже интересная тема!
8149 ОФЛАЙН, открыть меню «Личное сообщение»     - Любитель
Репутация: 2  [+] , сообщений: 12 ,  Belarus
28 Марта 2016
Да, хотелось бы увидеть продолжение темы.
Alefar ОФЛАЙН, открыть меню «Личное сообщение»     - Специалист   - Специалист
Репутация: 3  [+] , сообщений: 52 ,  BIM3D, http://bim3d.ru - Программирование под Revit, cтаж: 14 лет Belarus
28 Марта 2016
Поддержу тему. Расчет ведомости отделки в Excel для меня уже неактуален, так как код VBA совсем нечитабельный и сложный получается. Уже готов модуль для Dynamo который отделку, получаемую от Roombook систематизирует и отправляет в свойства помещений Revita. Остается только сделать Ведомость помещений с нужными полями и отделка готова. К сожалению прямо сейчас не могу выложить данный модуль, так как его надо привести в опрятный вид, на это пока нету времени. Будет время - напишу об этом подробнее.
8149 ОФЛАЙН, открыть меню «Личное сообщение»     - Любитель
Репутация: 2  [+] , сообщений: 12 ,  Belarus
29 Марта 2016
Только не забудьте)
gRanid ОФЛАЙН, открыть меню «Личное сообщение»     - Любитель
Репутация: 0  [+] , сообщений: 2 ,  Russian Federation
28 Октября 2016
Похоже забыл =)
Alefar ОФЛАЙН, открыть меню «Личное сообщение»     - Специалист   - Специалист
Репутация: 3  [+] , сообщений: 52 ,  BIM3D, http://bim3d.ru - Программирование под Revit, cтаж: 14 лет Belarus
02 Ноября 2016
Добрый день. Много воды утекло с тех пор как я создал эту тему и сейчас мне отделка в Ревите неинтересна. Есть рабочие решения в Динамо, можете погуглить их, они даже на Ютуб есть. Есть краска в Ревите, есть детали, хватает способов посчитать отделку. Если хотите узнать, что я еще делаю для Ревит и скачать мои приложения для Ревит - заходите на мой блог по программированию в Ревит - http://bim3d.ru/blog/
gRanid ОФЛАЙН, открыть меню «Личное сообщение»     - Любитель
Репутация: 0  [+] , сообщений: 2 ,  Russian Federation
02 Ноября 2016
Добрый день! Спасибо за выложенные решение проблемы, вполне возможно , что пригодится в будущем.
 Стр.: [1]   

 Архитектура и дизайн (в разделе 1065 тем):
Подработки раздела (6):
Реконструкция нежилого помещения в многоквартирном жилом доме, г.Минск (АР)
ГИП для работы в Гродно. Можно совместительство, 1000$, РБ (Все разделы)
Цветовые решения фасадов многоквартирных жилых домов, РБ (АР)
Руководитель проектов, сеть магазинов Мила,1000$ (Все разделы)
Top Mountain Crosspoint - динамичное дерево и серьезная техника.
На высоте 2175 метров был открыт мультифункциональный комплекс «Top Mountain Crosspoint», архитектура которого имитирует форму снежного карниза и напоминает извилистую горнолыжную трассу. В этом здании  под одной крышей собрались четыре совершенно разных вида деятельности: самый высокогорный в Европе музей мотоциклов, ресторан с панорамным видом, гондольная канатная дорога и пункт оплаты высокогорной дороги Тиммельсйох.
Фанера в современном интерьере. Выпуск 3.
Кажется, мы все немного под устали от безжизненного белого гипсокартона в домашнем интерьере. А ведь вместо него можно использовать фанеру, которая обладает естественной природной красотой. Сомневаетесь? Взгляните на эти потрясающие фанерные интерьеры и сомнения отпадут!
Ворота Ryterna c новым трехмерным дизайном (3D-эффект).
Специальный монтаж - надежный подрядчик (ПС,ОП,ОС,ВН,СКУД,СС,АПТ,ПДЗ).
8 из 10 сертификатов ИСО 9001 аннулируются... Причины и последствия.
Ищете специалистов для разработки разделов проектной документации?!
Применение сигнально - локализационных лент. В чем выгода?
Как оформить прихожую в стиле лофт.
cellspacing="0" cellpadding="3" border="0" > Онлайн 671, всего 155369(+36) пользователей |
Powered by SMF 1.1.11 | SMF © 2006, Simple Machines LLC
Статистика и условия размещения рекламы на Proekt.by