I’m not for the Revit thing, but following the BIM master class I have to deal with this kind of software.
The practices needs to perform some repeated tasks, not a lot by now, but they will reach a point when they will start to bother me if I repeat them. So I looked for some automatization in the Revit world. For my desesperation, no VBA there, only C# and VB.Net rubbish.
First I must state that coming from the Excel VBA environment, the Revit macro manager environment looked like a baby (to say it pollitely). I’m shocked on how it performs every task so slow, and the little power for debugging that has been put there.
At the end of the day, playing around with Revit and the code I had found so far, I get the idea that Revit is very very very raw, still changing how to access the core components. Most of the code was not working because it has been deprecated, or some methods are not there anymore to be called. I feel frustrated. From this point, it starts the history of my struggle to get the thing working.
In AutoCad I was able to perform with VBA such a vast kind of operations with ease, and I had a lot of documentation to learn. Now, I run short of these documentation. Even the Revit online “help” is not helping too much, as the samples they say to be on the installation package are not there (2019 version)… and that you have to search on the web to see that is another package (360MB for this 2019 version) -when the installation package is 15 GB on itself-. Go here for other Revit versions.
Also the info page was very uninformative, as the code was not easy to take. Oh my god, if you only posted in HTML. Go here to get the original code:
Public Sub MyFirstMacroDocVB() Dim baseVec As Autodesk.Revit.DB.XYZ = Document.Application.Create.NewXYZ(1.0, 0.0, 0.0) Dim upVec As Autodesk.Revit.DB.XYZ = Document.Application.Create.NewXYZ(0.0, 0.0, 1.0) Dim origin As Autodesk.Revit.DB.XYZ = Document.Application.Create.NewXYZ(0.0, 0.0, 0.0) Dim align As Autodesk.Revit.DB.TextAlignFlags = Autodesk.Revit.DB.TextAlignFlags.TEF_ALIGN_LEFT Or Autodesk.Revit.DB.TextAlignFlags.TEF_ALIGN_TOP Dim pView As Autodesk.Revit.DB.View = Document.ActiveView Dim Transaction As Autodesk.Revit.DB.Transaction = New Autodesk.Revit.DB.Transaction(Document, "NewTextNote") Transaction.Start() Document.Create.NewTextNote(pView, origin, baseVec, upVec, lineWidth, align, strText) Transaction.Commit() End SubAnd there is some information about plugins on the Autodesk site, but did not get yet into it, as it seems a little boring to follow. Aside the Autodesk there are some other sources: The best resource I finally found was this document from Jeremy Tammik’s site. But the whole document is C# flavour that I do know little right now. Another one is this Harry Mattison’s site, Boost your BIM, with the Udemy courses. Go follow his site, and look for the products he has developed. The courses on Udemy look interesting as well. Also, there are some projects on GitHub dealing with teaching and addons:
- https://github.com/ADN-DevTech/RevitTrainingMaterial
- https://github.com/jeremytammik/VisualStudioRevitAddinWizard
- https://github.com/jeremytammik/RevitLookup (more about this here)
Public Sub DeleteUnusedViews()
'define current document
Dim currentDoc As Document = Me.Application.ActiveUIDocument.Document
'get all views
Dim viewCollector = New FilteredElementCollector(currentDoc)
viewCollector.OfCategory(BuiltInCategory.OST_Views)
'get all sheets
Dim sheetCollector = New FilteredElementCollector(currentDoc)
sheetCollector.OfCategory(BuiltInCategory.OST_Sheets)
'create list of views to delete
Dim viewsToDelete As New List(Of View)
'loop through views and check if it's on a sheet
For Each curview As View In viewCollector 'check if current view is a template
If curview.IsTemplate = False Then
'check if view can be added to sheet
If Viewport.CanAddViewToSheet(currentDoc, sheetCollector.FirstElement.Id, curview.Id) = True Then
'add view to delete list
viewsToDelete.Add(curview)
End If
End If
Next
'create transaction
Dim curTrans As New Transaction(currentDoc)
curTrans.Start("Delete unused views")
'delete views in list
For Each curViewToDelete As View In viewsToDelete
currentDoc.Delete(curViewToDelete.Id)
Next
'commit changes
curTrans.Commit
curTrans.Dispose
'alert the user
TaskDialog.Show("Deleted Views", "Deleted " & viewsToDelete.Count & " views.")
End Sub
Public Sub CreateSheets()
'create current document
Dim curDoc As Document = Me.Application.ActiveUIDocument.Document
'specify CSV file
Dim CSVFile As String = "C:\RTCNA 2016\Sheet List.csv"
'create list for sheet information
Dim sheetList As New List(Of String())
'create reader and read CSV file
Dim myReader = New Microsoft.VisualBasic.FileIO.TextFieldParser(CSVFile)
myReader.TextFieldType = Microsoft.VisualBasic.FileIO.FieldType.Delimited
myReader.Delimiters = New String() {","}
'create variable to hold current row of CSV file
Dim currentRow As String()
'loop through data, read each line and put into sheet list array
While Not myReader.EndOfData
currentRow = myReader.ReadFields
'add sheet to list
sheetList.Add(currentRow)
End While
'get titleblock instance
Dim curCollector As New FilteredElementCollector(curDoc)
curCollector.OfCategory(BuiltInCategory.OST_TitleBlocks)
'get all views in current project
Dim viewCollector As New FilteredElementCollector(curDoc)
viewCollector.OfCategory(BuiltInCategory.OST_Views)
'create transaction
Using curTrans As New Transaction(curDoc, "Create Sheets")
If curTrans.Start = TransactionStatus.Started Then 'loop through sheet array and create new sheets
For Each curSheet In sheetList
Dim newSheet As ViewSheet
'create the sheet
newSheet = ViewSheet.Create(curdoc, curCollector.FirstElementId)
'update the sheet's parameters
newsheet.SheetNumber = curSheet(0)
newsheet.Name = curSheet(1)
'check if specified view in CSV file matches view in project file
For Each curView As View In viewCollector
If curView.Name = curSheet(2) Then
'add view to sheet if it isn't already on a sheet
Dim curVP As Viewport
If Viewport.CanAddViewToSheet(curDoc, newSheet.Id, curView.Id) = True Then
'add view to sheet
curVP = Viewport.Create(curDoc, newSheet.Id, curView.Id, New XYZ(0,0,0))
'position view in center of sheet
curVP.SetBoxCenter(getSheetCenter(curVP, newSheet))
Else
'alert user view is already on sheet
TaskDialog.Show("Alert", "View " & curView.Name & " is already located on a sheet.")
End If
End If
Next curView
Next curSheet
End If
'commit changes
curTrans.Commit
End Using
End Sub
Public Sub WallsFromLines()
'define active document
Dim curDoc As Document = Me.Application.ActiveUIDocument.Document
'collect all lines in project file
Dim lineCollector As New FilteredElementCollector(curDoc)
Dim lineFilter As New CurveElementFilter(CurveElementType.ModelCurve)
'create transaction
Using curTrans As New Transaction(curDoc, "add walls")
If curTrans.Start = TransactionStatus.Started Then
'loop through lines
For Each curline As ModelCurve In lineCollector.WherePasses(lineFilter)
'get current line's sketchplane -we'll use this to determine the line's level
Dim curSketchPlan As SketchPlane = curLine.SketchPlane
'get line's level from sketchplan
Dim levelCollector As New FilteredElementCollector(curDoc)
levelCollector.OfCategory(BuiltInCategory.OST_Levels).ToElements
'loop through levels - if current level matches sketchplane level then create wall
For Each curLevel In levelCollector.ToElements
If TypeOf curLevel Is Level Then
If curLevel.Name Like curSketchPlan.Name Then
'select wall type to create based on line's style
Dim curWalltype As Walltype
If curline.LineStyle.Name = "A-WALL" Then
curWalltype = getWallType(curDoc, "Generic - 2&rm - Filled")
ElseIf curLine.lineStyle.Name = "A-WALL-INT" Then
curWalltype = getWallType(curDoc, "Interior - 79mm Partition (1-hr)")
ElseIf curLine.LineStyle.Name = "A-HALL-GLA2" Then
curWalltype = getWallType(curDoc, "Storefront")
Else
curWalltype = getWallType(curDoc, "Generic - 200mm")
End If
'create wall from line
Dim newWall As Wall
newWall = Wall.Create(curDoc, curLine.GeometryCurve, curWalltype.Id, curLevel.Id, convertMMtoFT(4000), 0, False, False)
End If
End If
Next curLevel
Next curLine
End If
'commit changes to model
curtrans.Commit
End Using
End Sub
Public Function convertMMtoFT(mmDim As Double) As Double
'convert millimeters to feet
Dim convert As Double
convert = (mmDim/25.4)/12
Return convert
End Function
Public Function getWallType(curDoc As Document, wallTypeName As String) As WallType
'returns wall type object from specified wall type string
Dim curCollector As New FilteredElementCollector(curDoc)
curCollector.OfClass(GetType(WallType)).ToElements
For Each curWallType As WallType In curCollector
'Debug.Print (curWallType.Name.ToString)
If curWallType.Name.ToString Like wallTypeName Then
Return curWallType
Exit Function
End If
Next curWallType
Return curCollector.FirstElement
End Function
Public Sub RenumberDoors()
'define current project
Dim curDoc As Document = Me.Application.ActiveUIDocument.Document
'get all doors in project
Dim doorCollector As New FilteredElementCollector(curDoc)
doorCollector.OfCategory(BuiltInCategory.OST_Doors)
doorCollector.OfClass(GetType(FamilyInstance)).ToElements
'create transaction
Using curTrans As New Transaction(curDoc, "update door number")
If curTrans.Start = TransactionStatus.Started Then
'loop through each door and renumber
For Each curElem As Element In doorCollector.ToElements 'recast current element as family instance
Dim curDoor As FamilyInstance = CType(curElem, FamilyInstance)
'get current door's ToRoom parameter
Dim curDoorToRoom As Room = curDoor.ToRoom
Dim doorRoomNumber As String
'trap for errors when door doesn't have ToRoom number
Try
'set room number to variable
doorRoomNumber = curDoorToRoom.Number
Catch ex As Exception
'no ToRoom value so set to EXT for exterior door
doorRoomNumber = "EXT"
End Try 'set door's new door number
Dim paramlist As IList(Of Parameter) = curDoor.GetParameters("Mark")
For Each curParam As Parameter In paramList
'first clear the door number to prevent duplicates
curParam.Set("")
'add suffix to door number
Dim doorNumber As String
doorNumber = doorRoomNumber & "A"
'check if door number exists
If doesDoorNumberExist(curDoc, doorNumber) = True Then
doorNumber = doorRoomNumber & "B"
If doesDoorNumberExist(curDoc, doorNumber) = True Then
doorNumber = doorRoomNumber & "C"
End If
End If
'set new door number
curParam.Set(doorNumber)
Next
Next
End If
'commit changes to model curTrans.Commit
End Using
End Sub
Public Function doesDoorNumberExist(curDoc As Document, doorNum As String) As Boolean
'get all doors in project
Dim doorCollector As New FilteredElementCollector(curDoc)
doorCollector.OfCategory(BuiltInCategory.OST_Doors)
'loop through each door and renumber
For Each curElem As Element In doorCollector.ToElements
If TypeOf curElem Is FamilyInstance Then
'recast current element as family instance
Dim curDoor As FamilyInstance = CType(curElem, FamilyInstance)
'get door mark parameter
Dim paramlist As Ilist(Of Parameter) = curDoor.GetParameters("Mark")
For Each curParam As Parameter In paramList
If curParam.AsString Like doorNum Then
Return True
Exit Function
End If
Next curParam
End If
Next curElem
Return False
End Function
'------------------------------------
There are other sources of information I went upon.
The second one was this another blog, that only have a bunch of posts and it went silent after that. Did not try.
This blog provided a lot of information, more specific, this post. Following sample comes from there
#Region "This is the code to be collapsed"
Public Sub CreatePrintSet_from_DrawingSheetSeriesParameter()
'If you are copying this macro to Application-Level Macro (computer specific macro) remove ".application" after "Me." below an change "Partial Public Class ThisDocument" to "ThisApplication" above.
Dim curDoc As Document = Me.Application.ActiveUIDocument.Document
'This is a list to store all Sheet parameter values for comparison
Dim SheetParamlist As New List(Of String)
'This is a list to store all Print Sets actually created
Dim createdPrintSets As New List(Of String)
'get list of all sheets in project file
Dim sheetList As List(Of ViewSheet) = getAllSheets(curDoc)
'get list of all ViewSheetSets in project file
For Each curSheet As ViewSheet In sheetList
Dim DrawingSheetSeries As String
If curSheet.LookupParameter("Drawing Sheet Series").AsString IsNot Nothing
DrawingSheetSeries = curSheet.LookupParameter("Drawing Sheet Series").AsString
'Make a VPrint Set only for Sheets in a specific group defined by parameter
If DrawingSheetSeries.Contains("") Then
'Leave empty if you don't need to filter parameter names
'If you need to filter off some parameter names add text between "". i.e DrawingSheetSeries.Contains("24")
'Check if a sheet is already added to a print set by checking if its parametre is on the list
If SheetParamlist.Contains(DrawingSheetSeries) Then
Else
'add parameter to the list and make a print set from all drawings with this parameter
Dim newViewSet As New ViewSet
SheetParamlist.Add(DrawingSheetSeries)
'this adds all drawings to a new print set
For Each Sheetinlist As ViewSheet In sheetList
If DrawingSheetSeries = Sheetinlist.LookupParameter("Drawing Sheet Series").AsString Then
newViewSet.Insert(Sheetinlist)
End If
Next
'get the PrintManger from the current document
Dim printManager As PrintManager = curDoc.PrintManager
'set this PrintManager to use the "Selected Views/Sheets" option
printManager.PrintRange = PrintRange.Select
'get the ViewSheetSetting which manages the view/sheet set information of current document
Dim viewSheetSetting As ViewSheetSetting = printManager.ViewSheetSetting
'set the views in this ViewSheetSetting to the newly created ViewSet
viewSheetSetting.CurrentViewSheetSet.Views = newViewSet
Dim setName As String = DrawingSheetSeries
'create transaction
Using curTrans As New Transaction(curDoc, "Create Sheet Sets")
curTrans.Start()
Try
'Save the current view sheet set to another view/sheet set with the specified name.
viewSheetSetting.SaveAs(setName)
'commit changes
curTrans.Commit
createdPrintSets.Add(setName)
'handle the exception that will occur if there is already a view/sheet set with this name
Catch ex As Autodesk.Revit.Exceptions.InvalidOperationException
Dim td As New TaskDialog("TaskDialog")
td.CommonButtons = TaskDialogCommonButtons.Ok
td.CommonButtons = TaskDialogCommonButtons.Cancel
'td.MainIcon = TaskDialogIcon.TaskDialogIconWarning
td.AllowCancellation = True
td.MainInstruction = "Print Set """ & setName & """ is already in use"
td.ExpandedContent = "Existing print set will be renamed to: ""name_old1"" (or ""_ 2__etc.)." & Environment.NewLine & "New print set will be named: ""name_1"" (or ""_ 2__etc.)."
td.MainContent = "What would you like to do:"
td.AddCommandLink(TaskDialogCommandLinkId.CommandLink1, "Replace existing Print Set")
td.AddCommandLink(TaskDialogCommandLinkId.CommandLink2, "Rename existing Print Set")
td.AddCommandLink(TaskDialogCommandLinkId.CommandLink3, "Rename this Print Set")
Dim tdResult As TaskDialogResult = td.Show()
curTrans.RollBack()
'OPTION 1: If user clicks the first command link: "Replace existing Print Set"
If TaskDialogResult.CommandLink1 = tdResult Then
curTrans.Start()
Dim VSSList As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
For Each viewSheetSet0 As ViewSheetSet In VSSList
If viewSheetSet0.Name = setName Then
viewSheetSetting.CurrentViewSheetSet.Views = newViewSet
viewSheetSetting.SaveAs(setName & "_temp")
viewSheetSetting.CurrentViewSheetSet = viewSheetSet0
viewSheetSetting.Delete
Dim VSSList3 As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
For Each viewSheetSet1 As ViewSheetSet In VSSList3
If viewSheetSet1.Name = (setName & "_temp") Then
viewSheetSetting.CurrentViewSheetSet = viewSheetSet1
viewSheetSetting.Rename(setName)
End If
Next
End if
Next
curTrans.Commit
createdPrintSets.Add(setName)
'OPTION 2: If user clicks the first command link: "Rename existing Print Set"
ElseIf TaskDialogResult.CommandLink2 = tdResult Then
curTrans.Start()
Dim VSSList1 As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
For Each viewSheetSet2 As ViewSheetSet In VSSList1
If viewSheetSet2.Name = setName Then
viewSheetSetting.CurrentViewSheetSet.Views = newViewSet
viewSheetSetting.SaveAs(setName & "_temp")
viewSheetSetting.CurrentViewSheetSet = viewSheetSet2
Try
viewSheetSetting.Rename(setName & "_old1")
TaskDialog.Show("ViewSetRenameOld","Existing print set was renamed to: """ & setName & "_old1""")
Catch ex2 As Autodesk.Revit.Exceptions.InvalidOperationException
curTrans.RollBack()
Dim VSSList4 As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
Dim i As Integer = 1
Dim Z As Boolean = False
Do While Z = False
For Each viewSheetSet4 As ViewSheetSet In VSSList4
If viewSheetSet4.Name = (setName & "_old" & i) Then
i = i + 1
Else
Z = True
End If
Next
Loop
curTrans.Start()
viewSheetSetting.SaveAs(setName & "_old" & i)
TaskDialog.Show("ViewSetRenameOld","Existing print set was renamed to: """ & setName & "_old" & i)
End Try
End If
Next
Dim VSSList2 As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
For Each viewSheetSet3 As ViewSheetSet In VSSList2
If viewSheetSet3.Name = setName & "_temp" Then
viewSheetSetting.CurrentViewSheetSet = viewSheetSet3
viewSheetSetting.Rename(setName)
End If
Next
curTrans.Commit
createdPrintSets.Add(setName)
'OPTION 3: If user clicks the second command link: "Rename this Print Set"
ElseIf TaskDialogResult.CommandLink3 = tdResult Then
Try
curTrans.Start()
'Save the current view sheet set to another view/sheet set with the specified name.
viewSheetSetting.SaveAs(setName & "_1")
'commit changes
curTrans.Commit
createdPrintSets.Add(setName & "_1")
'handle the exception that will occur if there is already a view/sheet set with this name
Catch ex1 As Autodesk.Revit.Exceptions.InvalidOperationException
curTrans.RollBack()
Dim VSSList As List(Of ViewSheetSet) = getAllViewSheetSets(curDoc)
Dim i As Integer = 1
Dim Z As Boolean = False
Do While Z = False
For Each viewSheetSet2 As ViewSheetSet In VSSList
If viewSheetSet2.Name = (setName & "_" & i) Then
i = i + 1
Else
Z = True
End If
Next
Loop
curTrans.Start()
viewSheetSetting.SaveAs(setName & "_" & i)
curTrans.Commit
createdPrintSets.Add(setName & "_" & i)
End Try
Else
End If
End Try
End Using
End If
Else
End If
Else
End If
Next
If createdPrintSets.Count = 0 Then
TaskDialog.Show("End", "NO PRINT SETS CREATED!")
Else
TaskDialog.Show("End", "No of Prints Sets Created: "& createdPrintSets.Count & Environment.NewLine & Environment.NewLine & "Names of Print Sets Created: "& Environment.NewLine & (String.Join(Environment.NewLine, createdPrintSets.ToArray)))
End If
End Sub
#End Region
'----------------------------------------------------
'collector
'----------------------------------------------------
Public Function getAllSheets(curDoc As Document) As List(Of ViewSheet)
'get all views
Dim sheetCollector As New FilteredElementCollector(curDoc)
sheetCollector.OfCategory(BuiltInCategory.OST_Sheets)
Dim SheetsCollection As New List(Of ViewSheet)
For Each x As ViewSheet In sheetCollector.ToElements
SheetsCollection.Add(x)
Next
Return SheetsCollection
End Function
Public Function getAllViewSheetSets(curDoc As Document) As List(Of ViewSheetSet)
'get all ViewSheetSets
Dim VSSCollector As New FilteredElementCollector(curDoc)
VSSCollector.OfClass(GetType(ViewSheetSet))
Dim VSSCollection As New List(Of ViewSheetSet)
For Each s As ViewSheetSet In VSSCollector.ToElements
VSSCollection.Add(s)
Next
Return VSSCollection
End Function
Following this post of Luisa Santamaría Gallardo, reached some useful information also. For the english spoken I have to say it’s in spanish. But I must recommend to look for www.revitapisearch.com on the archive.org for some indexed information.