CAD Forum

Code: Select all

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim swApp As Object
Sub main()
Set swApp = Application.SldWorks

Sleep (1000)

End Sub

Code: Select all

Sub main()
    Shell ("C:\PathToYourEXEFile\SolidworksScript.exe")
End Sub

Code: Select all

Const ForReading = 1

Dim arrLine()
Dim lnCnt

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile("c:\temp\BOMTable_Export_TESTING.SLDASM.txt", ForReading)

'Read the csv file to get the header column names and data for each row.
Do Until objTextFile.AtEndOfStream
	strNextLine = objTextFile.Readline
	lnCnt = lnCnt + 1
	If lnCnt = 2 Then
		arrHeaders = Split(strNextLine, vbTab)
	End If
	If lnCnt > 2 Then
		Redim Preserve arrLine(lnCnt - 2)
		arrLine(lnCnt - 2) = strNextLine
	End If	
Loop
objTextFile.Close	

'Load the data into a multidimentional array.
ReDim arrData(UBound(arrLine), UBound(arrHeaders))
For i = 0 to Ubound(arrLine)
	line = Split(arrLine(i), vbTab)
	For p = 0 to UBound(line)
		arrData(i, p) = line(p)
	Next
Next

'Find operations notes and raw material.
ReDim arrOperations(0)
ReDim tmpMaterial(0)
ReDim tmpMatIdx(0)
ReDim tmpMatQty(0)
For i = 0 to UBound(arrData, 1)

	curOper = arrData(i, GetColumnIndex("RawOperation"))
	If curOper <> "" Then
		idx = -1
		For o = 0 to UBound(arrOperations)
			If InStr(1, arrOperations(o), curOper) = 1 Then
				idx = o
				Exit For
			End If
		Next
		If idx = -1 Then
			Redim Preserve arrOperations(UBound(arrOperations) + 1)
			Redim Preserve arrRawMaterial(UBound(arrRawMaterial) + 1)
			idx = UBound(arrOperations)
			'Begin operation notes.
			arrOperations(idx) = curOper
			If arrData(i, GetColumnIndex("RawNote1")) <> "" Then arrOperations(idx) = arrOperations(idx) & vbCrlf & arrData(i, GetColumnIndex("RawNote1"))
			If arrData(i, GetColumnIndex("RawNote2")) <> "" Then
				arrOperations(idx) = arrOperations(idx) & vbCrlf & arrData(i, GetColumnIndex("RawNote2"))
				qty = arrData(i, GetColumnIndex("<FONT size=57PTS>QTY."))
				If qty > 1 Then arrOperations(idx) = arrOperations(idx) & vbCrlf & "(" & qty & " PER UNIT)"
			End If
			
			'Begin raw material
			mat = arrData(i, GetColumnIndex("RawPartNo"))
			If mat <> "" Then
				matIdx = -1
				For m = 0 to UBound(tmpMaterial)
					If mat = tmpMaterial(m) Then
						matIdx = m
						Exit For
					End If	
				Next
				If matIdx = -1 Then
					Redim Preserve tmpMaterial(UBound(tmpMaterial) + 1)
					Redim Preserve tmpMatIdx(UBound(tmpMatIdx) + 1)
					Redim Preserve tmpMatQty(UBound(tmpMatQty) + 1)
					matIdx = UBound(tmpMaterial)
					tmpMaterial(matIdx) = mat
					tmpMatIdx(matIdx) = idx
					tmpMatQty(matIdx) = CDbl(arrData(i, GetColumnIndex("RawMaterialQty")))
				Else
					tmpMatQty(matIdx) = CDbl(tmpMatQty(matIdx)) + CDbl(arrData(i, GetColumnIndex("RawMaterialQty")))
				End If
			End If
		Else
			'Add operation notes.
			If arrData(i, GetColumnIndex("RawNote1")) <> "" Then arrOperations(idx) = arrOperations(idx) & vbCrlf & vbCrlf & arrData(i, GetColumnIndex("RawNote1"))
			If arrData(i, GetColumnIndex("RawNote2")) <> "" Then 
				arrOperations(idx) = arrOperations(idx) & vbCrlf & arrData(i, GetColumnIndex("RawNote2"))
				qty = arrData(i, GetColumnIndex("<FONT size=57PTS>QTY."))
				If qty > 1 Then arrOperations(idx) = arrOperations(idx) & vbCrlf & "(" & qty & " PER UNIT)"
			End If
			
			'Add raw material
			mat = arrData(i, GetColumnIndex("RawPartNo"))
			If mat <> "" Then
				matIdx = -1
				For m = 0 to UBound(tmpMaterial)
					If mat = tmpMaterial(m) Then
						matIdx = m
						Exit For
					End If	
				Next
				If matIdx = -1 Then
					Redim Preserve tmpMaterial(UBound(tmpMaterial) + 1)
					Redim Preserve tmpMatIdx(UBound(tmpMatIdx) + 1)
					Redim Preserve tmpMatQty(UBound(tmpMatQty) + 1)
					matIdx = UBound(tmpMaterial)
					tmpMaterial(matIdx) = mat
					tmpMatIdx(matIdx) = idx
					tmpMatQty(matIdx) = CDbl(arrData(i, GetColumnIndex("RawMaterialQty")))
				Else
					tmpMatQty(matIdx) = CDbl(tmpMatQty(matIdx)) + CDbl(arrData(i, GetColumnIndex("RawMaterialQty")))
				End If
			End If
		End If
		
		
		
	End If
Next

'Display output
Set outFile = objFSO.CreateTextFile("c:\temp\operationnotes.csv", True)
Dim oLine
For i = 0 to UBound(arrOperations)
	oLine = chr(34) & Replace(arrOperations(i), chr(34), chr(34) & chr(34)) & chr(34)
	For m = 0 to UBound(tmpMatIdx)
		If tmpMatIdx(m) = i Then
			oLine = oLine & ", " & tmpMaterial(m) & ", " & tmpMatQty(m)
		End If
	Next
	outFile.WriteLine(oLine)
	'Wscript.Echo arrOperations(i) & vbCrlf & vbCrlf
Next
outFile.Close
	
'Returns the index number of the column name passed.
Function GetColumnIndex(columnName)
	GetColumnIndex = 0
	
	For c = 0 to UBound(arrHeaders)
		If arrHeaders(c) = columnName Then
			GetColumnIndex = c
			Exit For
		End If
	Next
End Function