excel vba to drive inventor
adetes3,
If I understand your situation correctly, you have an Excel worksheet filled out similarly to the image below:
I came up with a code which would loop through each file, get the properties listed in B1:D1 and place their values in their
corresponding cells. The code isn't very robust, so if you have iProperties in areas other than "Design Tracking Properties",
it won't work properly. Hope this gives you a decent start. Let me know if you have any questions on the code.
Sub GetProperties()
Dim oWkbk As Workbook
Set oWkbk = ThisWorkbook
Dim oSheet As Worksheet
Set oSheet = oWkbk.ActiveSheet
' Define range where properties are
sPropRange = "B1:D1"
' Define range of filepaths
sFilepathRange = "A2:A2"
Dim oPropNames As Collection
Set oPropNames = New Collection
' Add property names to collection
For Each oCell In oSheet.Range(sPropRange)
oPropNames.Add (oCell.Value)
Next oCell
' Get new instance of Inventor
Dim oInvApp As Inventor.Application
Set oInvApp = CreateObject("Inventor.Application")
Dim invSummaryInfo As PropertySet
Dim oDoc As Inventor.Document
Dim sFilePath As String
' Loop through files
For Each oCell In oSheet.Range(sFilepathRange)
' Open file invisibly
Set oDoc = oInvApp.Documents.Open(oCell, False)
' Get design tracking properties of document
Set invSummaryInfo = oDoc.PropertySets.Item("Design Tracking Properties")
i = 1
' For each property, get value and place in corresponding cell
For Each oItem In oPropNames
oCell.Offset(0, i).Value = invSummaryInfo.Item(CStr(oItem)).Value
i = i + 1
Next oItem
' Close document and move onto next
oDoc.Close
Next oCell
Set oInvApp = Nothing
End Sub
foxrid3r,
Thanks for taking the time to help. I just reread my post and it was confusing, so let me see if I can describe it better here. Shown below is an image example of the excel set up I have with inputs and inventor sheet. The “inventor” sheet is set up with 3 columns; parameter name, value, and units. What I was trying to do was to write a vba inside the excel that allows user to browse for inventor file (part or assembly) as shown on the image the inventor file will have user parameters with the same name as shown in the “inventor” sheet, so once the user finds and opens the file the code would compare the parameter name from the excel to the one in the inventor file and if they are same copy the value and unit to the inventor file and loop for each parameter. Sorry I haven't gone through your code yet, I just want to reexplain my post. Would this be easier in reverse where the code will be inside inventor file then look for excel with the same parameter name...?
Sincerely,
Adam T.
Accepted solution
Adam,
Here is what I came up with. You'll have to modify it slightly to suit your needs, but it should be a good start. I should note that you will have to add a reference to the Excel library in order to use functions/classes native to Excel. To do this, open the VBA editor in Inventor, go to Tools>References and check the box for "Microsoft Excel XX.0 Object Library". Let me know if you run into any trouble.
Here is the Excel file I was working with:
Sub GetProperties()
Dim oApp As Application
Set oApp = ThisApplication
Dim oDoc As Document
Set oDoc = oApp.ActiveDocument
' Check if user is in part or assembly
If oDoc Is Nothing Or TypeOf oDoc Is DrawingDocument Then
Exit Sub
End If
Dim oCompDef As ComponentDefinition
' Get component definition
Set oCompDef = oDoc.ComponentDefinition
Dim oParams As Parameters
Dim oParam As Parameter
' Get paramters object
Set oParams = oCompDef.Parameters
Dim oExcel As Excel.Application
' Create Excel object
Set oExcel = CreateObject("Excel.Application")
' Define sheet name where information resides
Dim sSheetName As String
sSheetName = "inventor"
Dim sFilePath
' Prompt user to select Excel file to read from
' Alternatively, you could hard code the filepath like this:
' sFilePath = "C:/ExcelFile.xlsx"
sFilePath = oExcel.GetOpenFilename(FileFilter:="Excel Files (*.xls*),*.xls*", Title:="Select Excel File to Read From")
Dim oWkbk As Workbook
' Open Excel file invisibly
If sFilePath = False Then
Exit Sub
Else
Set oWkbk = oExcel.Workbooks.Open(sFilePath, False)
End If
Dim oSheet As WorkSheet
' Get specified sheet
Set oSheet = oWkbk.Sheets(sSheetName)
' Set range where parameter names reside in sheet
Dim sParamRange As String
sParamRange = "A2:A6"
Dim oCell As Range
' Loop through each parameter listed in sheet
For Each oCell In oSheet.Range(sParamRange)
' Parse through parameters and check to see if parameter name matches current parameter from Excel
For Each oParam In oParams
' If names match, copy value and units from Excel into parameter expression
If oCell.Value = oParam.Name Then
oParam.Expression = oCell.offset(0, 1).Value & oCell.offset(0, 2).Value
End If
Next oParam
Next oCell
' Close workbook
Call oWkbk.Close
Set oExcel = Nothing
' Update part/assembly
oDoc.Update
End Sub
