hi @AnthonyMcTigue
I fully understand your concerns regarding the way section names are currently managed, as well as the difficulties non-developers face when working with catalog files.
Below is a code snippet you can use as a starting point to rename sections sourced from a custom catalog within your projects.
Sub RenameAllSectionsFromCustomDB()
Dim RobApp As RobotApplication
Set RobApp = New RobotApplication
If Not (RobApp.Visible = -1 And RobApp.Project.IsActive = -1) Then
Set RobApp = Nothing: Exit Sub
End If
Dim Bars As RobotBarServer, Labels As RobotLabelServer
Dim Label As RobotLabel, LabelData As IRobotBarSectionData
Dim NewLabel As RobotLabel, NewLabelData As IRobotBarSectionData
Dim LabelSectionsCollection As RobotLabelCollection
Dim Selections As RobotSelectionFactory, BarSel As RobotSelection
Dim Preferences As RobotProjectPreferences
Dim Materials As RobotMaterialDatabase, SectionsActive As RobotSectionDatabaseList
With RobApp.Project
Set Preferences = .Preferences
With Preferences
Set Materials = .Materials
Set SectionsActive = .SectionsActive
End With
With .Structure
Set Bars = .Bars
Set Labels = .Labels
Set Selections = .Selections
End With
End With
Set LabelSectionsCollection = Labels.GetMany(I_LT_BAR_SECTION)
Dim SectionDBName As String, MaterialDBName As String:
SectionDBName = "CustomDBName"
MaterialDBName = "MaterialDBName"
If Not IsAvailableDB(SectionsActive, SectionDBName) Then
MsgTxt = "The sections database " & SectionDBName & " has not been loaded" & vbCrLf & _
"Do you want to add the database to the project preferences?"
If MsgBox(MsgTxt, vbYesNo + vbQuestion, "Database Loading") = vbYes Then
Preferences.SetCurrentDatabase I_DT_SECTIONS, SectionDBName
If Not IsAvailableDB(SectionsActive, SectionDBName) Then
Set RobApp = Nothing: Exit Sub
End If
Else
Set RobApp = Nothing: Exit Sub
End If
End If
Dim SectionDB As RobotSectionDatabase
Dim AvailableMaterials As RobotNamesArray, Sections As RobotNamesArray, AvailableSections As RobotNamesArray
Set Sections = RobApp.CmpntFactory.Create(I_CT_NAMES_ARRAY)
For idx = 1 To SectionsActive.Count
Set SectionDB = SectionsActive.GetDatabase(idx)
If SectionDB.Name = SectionDBName Then Set Sections = SectionDB.GetAll
Next idx
Set AvailableSections = Labels.GetAvailableNames(I_LT_BAR_SECTION)
If Materials.Load(MaterialDBName) = 0 Then ' DB Material Not Found
MsgBox "The material database " & MaterialDBName & " has not been loaded", vbOKOnly & vbCritical, "Error"
Set RobApp = Nothing: Exit Sub
End If
Set AvailableMaterials = Materials.GetAll
Dim SectionName As String, MaterialName As String, RevitName As String
Dim HasMaterial As Boolean, IsFromDB As Boolean
Dim ExistRevitName As Boolean, HasRevitName As Boolean, IsUsed As Boolean
For i = 1 To LabelSectionsCollection.Count
Set Label = LabelSectionsCollection.Get(i)
Set LabelData = Label.Data
With LabelData
SectionName = .Name
MaterialName = .MaterialName
RevitName = ""
ExistRevitName = .FindAlias("NAME_REVIT", RevitName)
End With
HasRevitName = ExistRevitName And Not (RevitName = "" Or RevitName = "0")
HasMaterial = AvailableMaterials.Find(MaterialName, 1) > 0
IsFromDB = Sections.Find(SectionName, 1) > 0
IsUsed = AvailableSections.Find(SectionName, 1) > 0
ReadyForConversion = HasRevitName And HasMaterial And IsFromDB And IsUsed
If ReadyForConversion Then
NewName = RevitName
If Labels.IsAvailable(I_LT_BAR_SECTION, NewName) Then
MsgBox "The section name " & NewName & " already exists and cannot be created", vbExclamation, "Error"
Else
Set NewLabel = Labels.Create(I_LT_BAR_SECTION, NewName)
Set NewLabelData = NewLabel.Data
NewLabelData.MaterialName = MaterialName
NewLabelData.LoadFromDBase2 SectionName, SectionDBName
Labels.Store NewLabel
Set BarSel = Selections.CreateByLabel(I_OT_BAR, I_LT_BAR_SECTION, SectionName)
Bars.SetLabel BarSel, I_LT_BAR_SECTION, NewName
Labels.Delete I_LT_BAR_SECTION, SectionName
End If
End If
Next i
Set RobApp = Nothing
End Sub
Function IsAvailableDB(SectionsActive As RobotSectionDatabaseList, SectionDBName As String) As Boolean
Dim SectionDB As RobotSectionDatabase, Sections As RobotNamesArray
For i = 1 To SectionsActive.Count
Set SectionDB = SectionsActive.GetDatabase(i)
If SectionDB.Name = SectionDBName Then
Set Sections = SectionDB.GetAll
If Sections Is Nothing Then ' DB Section Not Found
MsgBox "The sections database " & SectionDBName & " does not exist", vbOKOnly + vbCritical, "Error"
IsAvailableDB = False: Exit Function
End If
If Sections.Count = 0 Then ' DB Section Empty
MsgBox "The sections database " & SectionDBName & " is empty", vbOKOnly + vbCritical, "Error"
IsAvailableDB = False: Exit Function
End If
IsAvailableDB = True: Exit Function
End If
Next i
IsAvailableDB = False
End Function
Should you have any other points to discuss or additional questions, please do not hesitate to inform me.
Best Regards
Stéphane Kapetanovic
Did you find this post helpful? If it gave you one or more solutions,
don't forget to accept the solution and leave a < like !
