how to map properties from excel to inventor using macro for inactive parts

[lohithna]

i have to write data from excel to inventor using macro , i found some macro for active compnents .i found some macro in solid works to write from excel to solidworks but inventor i didnt find please help on this ???   if have some   MACRO SAMPLE I HAVE FOR YOU EDIT 

[HermJan.Otterman]

hi,

why do you have to do this with a marco?

in Inventor you can link excel with a part or assembly.

your question is verry general, could you be more specific maybe with an example?

[basnederveen]

I do not know exactly what you mean but here's a script where i write some iproperties to excel according to the parts only BoM.

Private Sub BOMtest()

'generate mto script tests
'set variables
Dim oTemplate As String: oTemplate = "set ur template"
Dim oStartRow As Integer: oStartRow = 10

' set last column for array, array starts at 0 so its -1 quantity comes straight out of bom so we dont need to store it
Dim lastCol As Integer: lastCol = 7

'set individual columns for excel, use a number no letter
Dim nrCol As Long: nrCol = 1
Dim titleCol As Long:  titleCol = 2
Dim stocknoCol As Long: stocknoCol = 7
Dim comCol As Long: comCol = 5
Dim descCol As Long: descCol = 4
Dim massCol As Long: massCol = 8
Dim matCol As Long: matCol = 3
Dim qtyCol As Long: qtyCol = 9

'set assembly
Dim asm As AssemblyDocument
Set asm = ThisApplication.ActiveDocument

' set reference to referenced documents
Dim rds As DocumentsEnumerator
Set rds = asm.AllReferencedDocuments

' define bom
Dim oBOM As BOM
Set oBOM = asm.ComponentDefinition.BOM

' enable the parts only view
oBOM.PartsOnlyViewEnabled = True

' set the parts only view
Dim oBOMview As BOMView
Set oBOMview = oBOM.BOMViews("Parts only")

'set the properties we want to print
Dim oDescripProperty As Property
Dim oTitleProperty As Property
Dim oStockNoProperty As Property
Dim oCommentsProperty As Property

' store the columns in an array for easier printing
Dim oArray() As String
ReDim oArray(oBOMview.BOMRows.Count - 1, lastCol) As String

Dim a As Double: a = 0

' iterate trough bom rows
Dim oBOMrow As BOMRow
For Each oBOMrow In oBOMview.BOMRows
    
    ' setthe component definition
    Dim ocompdef As ComponentDefinition
    Set ocompdef = oBOMrow.ComponentDefinitions.Item(1)

    'Get the file property that contains the "Description"
    Set oDescripProperty = ocompdef.Document.PropertySets _
        .Item("Design Tracking Properties").Item("Description")
    
    ' set the title property
    Set oTitleProperty = ocompdef.Document.PropertySets _
    .Item("Inventor Summary Information").Item("Title")
    
     ' set the Stock Number property
    Set oStockNoProperty = ocompdef.Document.PropertySets _
    .Item("Design Tracking Properties").Item("Stock Number")
    
    ' set the Comments property
    Set oCommentsProperty = ocompdef.Document.PropertySets _
    .Item("Inventor Summary Information").Item("Comments")
    
    ' fill array
    oArray(a, 0) = (a + 1)
    oArray(a, 1) = oTitleProperty.Value
    oArray(a, 2) = oStockNoProperty.Value
    oArray(a, 3) = oCommentsProperty.Value
    oArray(a, 4) = oDescripProperty.Value
    oArray(a, 5) = Round(ocompdef.MassProperties.Mass, 3)
    oArray(a, 6) = ocompdef.Material.Name
    oArray(a, 7) = oBOMrow.ItemQuantity

    a = a + 1
    
Next
 'Stop
' set excel app and add worksheet
Dim xlApp As Object
Dim xlwb As Object
Dim xlws As Object
Set xlApp = CreateObject("Excel.Application")
'set xlwb = xlApp.workbooks.open(oTemplate)
Set xlwb = xlApp.Workbooks.Add
Set xlws = xlwb.Worksheets(1)
xlApp.Visible = True

' write more stuff
xlws.cells(2, 2) = asm.DisplayName
xlws.cells(4, 2) = Date

' set column heads
xlws.cells((oStartRow), nrCol) = "Nr."
xlws.cells((oStartRow), titleCol) = "Title"
xlws.cells((oStartRow), descCol) = "Description"
xlws.cells((oStartRow), massCol) = "Mass"
xlws.cells((oStartRow), matCol) = "Material"
xlws.cells((oStartRow), qtyCol) = "Quantity"

' print the array
Dim b As Double: b = 0

For b = 1 To oBOMview.BOMRows.Count

    ' print array
    xlws.cells(oStartRow + b, nrCol) = oArray(b - 1, 0)
    xlws.cells(oStartRow + b, titleCol) = oArray(b - 1, 1)
   ' xlws.Cells(oStartRow + b, stocknoCol) = oArray(b - 1, 2)
   ' xlws.Cells(oStartRow + b, comCol) = oArray(b - 1, 3)
    xlws.cells(oStartRow + b, descCol) = oArray(b - 1, 4)
    xlws.cells(oStartRow + b, massCol) = oArray(b - 1, 5)
    xlws.cells(oStartRow + b, matCol) = oArray(b - 1, 6)
    xlws.cells(oStartRow + b, qtyCol) = oArray(b - 1, 7)
Next


' save and close the document
' xlwb.SaveAs ("full string + doc name.xlsx")

' close the document
' Call xlwb.Close
End Sub

You can also write directly to excel, but i put the stuff in an array first because I had some problems when I wrote the data directly. Might just have been my computer I dont remember.. 

[lohithna]

thanks for your reply , i ahve sample excel format from solidworks software that as to work for inventor by altering some code as per inventor .

'

in this excel we select the folder or paste link in excel by pressing Import data Tab it going to extract file properties similarly export data , now I have extracted data in excel but its need to be write in inventor

all most script asking for active document to  write files , I have some doubt to write program . please kindly find attached file      

[lohithna]

macro is in english 

'*******************************************************
'SLOWorks.fi, 2014
'*******************************************

'variables and constants
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim spec As SldWorks.DocumentSpecification
Dim retval As Boolean

Dim File, Path, Title As String
Dim Attrkpl, Attrkplm As String
Dim AttrNimiSolu As Range
Dim Config As Variant
'Const swDocPart = 1
Const swCustomInfoText = 30

Private Sub CommandButton1_Click()

'how many attributes are read
Attrkpl = Taul1.Range("D3").Value
Attrkplm = "-" & Attrkpl

'' gripped 'to the SW
Set SwApp = CreateObject("SldWorks.Application")

SwApp.Visible = True

'Activate the sheeting for security
Worksheets("Parts").Activate

'read the directory
File = Dir(Taul1.Range("D4").Value & "\ *. Sldprt")

'read the given workbook
Path = Taul1.Range("D4").Value & "\"

'clears the old values ??and moves to the starting point
Sheet1.Range("A8:Z500").Select
Selection.ClearContents
Taul1.Range("A8").Select

'open files one after the other
Do While File <> ""

Set spec = SwApp.GetOpenDocSpec(Path & File)
spec.Silent = True

Dim err, war As Long
Set Model = SwApp.OpenDoc6(Path & File, SwConst.swDocumentTypes_e.swDocPart, SwConst.swOpenDocOptions_e.swOpenDocOptions_Silent, "", SwConst.swFileLoadError_e.swGenericError, SwConst.swFileLoadWarning_e.swFileLoadWarning_BasePartNotLoaded)

'LISTENED DATA NAME
ActiveCell.Value = File
ActiveCell.Offset(0, 1).Activate

'enter the custom cell text
ActiveCell.Value = "* Custom *"

'will move to the ekr attr value
ActiveCell.Offset(0, 1).Activate

'CUSTOM ATTRIBUTE
Set AttrNimiSolu = Taul1.Range("C6")

For i = 1 To Attrkpl

ActiveCell.Value = Model.GetCustomInfoValue("", AttrNimiSolu)
ActiveCell.Offset(0, 1).Activate

Set AttrNimiSolu = AttrNimiSolu.Offset(0, 1)
Next i

'NEXT. RIVI, CONFIGURATIONS
'will go to the ekan config name
ActiveCell.Offset(1, Attrkplm - 1).Activate

'read the template names
Config = Model.GetConfigurationNames

'for every car you make ...
For i = 0 To UBound(Config)
Set AttrNimiSolu = Taul1.Range("C6")
'enter the name into the cell
ActiveCell.Value = Config(i)

ActiveCell.Offset(0, 1).Activate

'read the data
For j = 1 To Attrkpl
ActiveCell.Value = Model.GetCustomInfoValue(Config(i), AttrNimiSolu)
ActiveCell.Offset(0, 1).Activate
Set AttrNimiSolu = AttrNimiSolu.Offset(0, 1)
Next j
ActiveCell.Offset(1, Attrkplm - 1).Activate

Next i

'transfer to the next file
ActiveCell.Offset(1, -1).Activate

'FOLDING FILE
Title = Model.GetTitle
SwApp.CloseDoc Title

'the next file
File = Dir()
Set SwApp = CreateObject("SldWorks.Application")

'looped until all folder filet passed through
Loop

MsgBox "Done!"

End Sub

Private Sub CommandButton2_Click()

'how many attributes are read
Attrkpl = Taul1.Range("D3").Value
Attrkplm = "-" & Attrkpl

'' gripped 'to the SW
Set SwApp = CreateObject("SldWorks.Application")

'Activate the sheeting for security
Worksheets("Parts").Activate

'read a work folder
Path = Taul1.Range("D4").Value & "\"

'to the start point
Taul1.Range("A8").Activate

'until the filename is empty, ie the templates are over ...
Do While ActiveCell.Value <> ""

'open the file
File = ActiveCell.Value
Set Model = SwApp.OpenDoc(Path & File, swDocPart)

ActiveCell.Offset(0, 2).Activate

'delete custom information and type new
Set AttrNimiSolu = Taul1.Range("C6")

For i = 1 To Attrkpl

retval = Model.DeleteCustomInfo2("", AttrNimiSolu)
retval = Model.AddCustomInfo3("", AttrNimiSolu, swCustomInfoText, ActiveCell.Value)

ActiveCell.Offset(0, 1).Activate

Set AttrNimiSolu = AttrNimiSolu.Offset(0, 1)
Next i

'Configuration information the same thing, first transfer
ActiveCell.Offset(1, Attrkplm - 1).Activate
Config = Model.GetConfigurationNames

For j = 0 To UBound(Config)
Set AttrNimiSolu = Taul1.Range("C6")
Configuration = ActiveCell.Value
For k = 1 To Attrkpl

ActiveCell.Offset(0, 1).Activate

If ActiveCell.Value <> "" Then
retval = Model.DeleteCustomInfo2(Configuration, AttrNimiSolu)
retval = Model.AddCustomInfo3(Configuration, AttrNimiSolu, swCustomInfoText, ActiveCell.Value)
Else
retval = Model.DeleteCustomInfo2(Configuration, AttrNimiSolu)
End If

Set AttrNimiSolu = AttrNimiSolu.Offset(0, 1)
Next k
ActiveCell.Offset(1, Attrkplm).Activate
Next j

'go next to the title
ActiveCell.Offset(1, -1).Activate

'save and close the already processed template
Model.Save
Title = Model.GetTitle
SwApp.CloseDoc Title

Set SwApp = CreateObject("SldWorks.Application")
Loop

MsgBox "Done!"

End Sub

[lohithna]

please find the requriment in excel attached