I was hoping somebody could help me understand why I am having issues with this code; I am getting a run-time error in this line of code
For i = 0 To UBound(vTable) 'which is the Ln 35, Col 36
Thank you.
'**********************
'Copyright(C) 2020 www.codestack.net
'Reference: https://www.codestack.net/solidworks-api/document/features-manager/rename-features-by-type-name/
'License: https://www.codestack.net/LICENSE.md
'**********************
Const NO_INCREMENT_FILE As String = "noincrement.csv"
Const CUSTOM_MAP_FILE As String = "custommap.csv"
Dim swApp As SldWorks.SldWorks
Sub main()
Set swApp = Application.SldWorks
Dim swPart As SldWorks.PartDoc
Set swPart = TryGetActivePart()
If Not swPart Is Nothing Then
Dim dicFeatsCount As Object
Dim collFeatsNonIncr As Collection
Dim dicBaseNames As Object
Set dicFeatsCount = CreateObject("Scripting.Dictionary")
Set collFeatsNonIncr = New Collection
Set dicBaseNames = CreateObject("Scripting.Dictionary")
Dim vTable As Variant
Dim i As Integer
vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & NO_INCREMENT_FILE, False)
For i = 0 To UBound(vTable)
collFeatsNonIncr.Add vTable(i)(0)
Next
vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & CUSTOM_MAP_FILE, False)
For i = 0 To UBound(vTable)
dicBaseNames.Add vTable(i)(0), vTable(i)(1)
Next
Dim swFeat As SldWorks.Feature
Set swFeat = swPart.FirstFeature
Dim curRefPlanePos As Integer
curRefPlanePos = 0
While Not swFeat Is Nothing
Dim newName As String
Dim typeName As String
typeName = GetTypeName(swFeat, curRefPlanePos)
If dicFeatsCount.exists(typeName) Then
dicFeatsCount.Item(typeName) = dicFeatsCount.Item(typeName) + 1
Else
dicFeatsCount.Add typeName, 1
End If
If dicBaseNames.exists(typeName) Then
newName = dicBaseNames.Item(typeName)
Else
newName = typeName
End If
Dim isIncremented As Boolean
isIncremented = True
For i = 1 To collFeatsNonIncr.Count
If collFeatsNonIncr(i) = typeName Then
isIncremented = False
Exit For
End If
Next
If isIncremented Then
newName = newName & dicFeatsCount.Item(typeName)
End If
If typeName = "MaterialFolder" Then
isRefGeom = True
Dim sMatName As String
sMatName = swPart.GetMaterialPropertyName2("", "")
If sMatName <> "" Then
newName = sMatName
End If
End If
swFeat.Name = newName
Set swFeat = swFeat.GetNextFeature
Wend
Else
MsgBox "Please open the part document"
End If
End Sub
Function GetTypeName(feat As SldWorks.Feature, ByRef curRefPlanePos As Integer) As String
Dim typeName As String
typeName = feat.GetTypeName2()
If typeName = "RefPlane" Then
Select Case curRefPlanePos
Case 0
typeName = "_FrontPlane"
Case 1
typeName = "_TopPlane"
Case 2
typeName = "_RightPlane"
End Select
curRefPlanePos = curRefPlanePos + 1
ElseIf typeName = "ICE" Then
typeName = feat.GetTypeName()
End If
GetTypeName = typeName
End Function
Function TryGetActivePart() As SldWorks.PartDoc
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
If swModel.GetType() = swDocumentTypes_e.swDocPART Then
Set TryGetActivePart = swModel
End If
End If
End Function
Function ReadCsvFile(filePath As String, firstRowHeader As Boolean) As Variant
'rows x columns
Dim vTable() As Variant
On Error GoTo Error
Dim fileName As String
Dim tableRow As String
Dim fileNo As Integer
fileNo = FreeFile
Open filePath For Input As #fileNo
Dim isFirstRow As Boolean
Dim isTableInit As Boolean
isFirstRow = True
isTableInit = False
Do While Not EOF(fileNo)
Line Input #fileNo, tableRow
If Not isFirstRow Or Not firstRowHeader Then
Dim vCells As Variant
vCells = Split(tableRow, ",")
Dim lastRowIndex As Integer
If Not isTableInit Then
lastRowIndex = 0
isTableInit = True
ReDim Preserve vTable(lastRowIndex)
Else
lastRowIndex = UBound(vTable, 1) + 1
ReDim Preserve vTable(lastRowIndex)
End If
vTable(lastRowIndex) = vCells
End If
If isFirstRow Then
isFirstRow = False
End If
Loop
Close #fileNo
ReadCsvFile = vTable
Exit Function
Error:
ReadCsvFile = Empty
End Function
