AnsweredAssumed Answered

run-time error in macro SolidWorks

Question asked by Christopher Torres on Apr 21, 2020
Latest reply on Apr 21, 2020 by Christopher Torres

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

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)

vTable = ReadCsvFile(swApp.GetCurrentMacroPathFolder() & "\" & CUSTOM_MAP_FILE, False)

For i = 0 To UBound(vTable)
dicBaseNames.Add vTable(i)(0), vTable(i)(1)

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
dicFeatsCount.Add typeName, 1
End If

If dicBaseNames.exists(typeName) Then
newName = dicBaseNames.Item(typeName)
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

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


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)
lastRowIndex = UBound(vTable, 1) + 1
ReDim Preserve vTable(lastRowIndex)
End If

vTable(lastRowIndex) = vCells

End If

If isFirstRow Then
isFirstRow = False
End If


Close #fileNo

ReadCsvFile = vTable

Exit Function


ReadCsvFile = Empty

End Function