Autodesk Inventor Customization

[#1]

I posted this discussion in another group http://forums.autodesk.com/t5/Autodesk-Inventor/BOM-INVENTORY-PROBLEM/td-p/3370343 and it has been suggested that I post the original VBA code here.

Basically, we have a macro written in VBA for Inventor 2011. This macro will cross reference part numbers from a BOM within Inventor 2011 with our MySQL database. It then populates the remaining BOM cells with data from MySQL such as part description and drawing number.

The other part of this macro will write to our MySQL database the BOM that has been created for a new assembly in Inventor.

So, we create the new assembly part number in the MySQL database, create the drawing of the assembly in Inventor, use Part List in Inventor to generate a custom BOM. Run the macro to fill in the remaining fields of that BOM, then run the macro to update MySQL with the new BOM for the new assembly. Now if I look at the MySQL database the new assembly part number lists all the sub-assemblies and parts associated.

The problem is that we are told that this version of VBA does not work with Inventor 2012 and above. Here is what I've been able to find for the code. I'm not a programer and the person who created this is no longer here.

Anyone able to help create this for Inventor 2012/2013?

Private Sub CommandButton1_Click()

'Setup part doc
Dim oPartDoc As Inventor.PartDocument
Set oPartDoc = ThisApplication.ActiveDocument

'setup parameter
Dim oParams As Parameters
Set oParams = oPartDoc.ComponentDefinition.Parameters
 
'Define the variables
Dim Material_Length As Double
Dim Material_Width As Double
Dim Fabrication_QTY As Double
Dim Fab_QTY_INT As Integer

'===Obtain the farication ProductID from iProp/Custom value
Dim Fabrication_Material As String

'Define the iProperty sets in the part doc
Dim oPropSets As PropertySets
Set oPropSets = oPartDoc.PropertySets

'This is to get the FXXX-XXX ID, predefined in part
Fabrication_Material = oPropSets.Item("User Defined Properties").Item("PID").Expression

'Product name (AKA description of the the material), predefined
Dim Fab_Prod_Name As String
Fab_Prod_Name = oPropSets.Item("User Defined Properties").Item("PN").Expression

'Get length, width from Parameter and calcualte DTY
Material_Length = oParams.Item("Fab_Length").Value / 2.54
Material_Width = oParams.Item("Fab_Width").Value / 2.54
Fabrication_QTY = Material_Length * Material_Width

'Change the value to Interger in different situations
If (CInt(Fabrication_QTY) >= Fabrication_QTY) Then
    Fab_QTY_INT = CInt(Fabrication_QTY)
Else
    Fab_QTY_INT = CInt(Fabrication_QTY) + 1
End If

'My SQL Connect
Dim Conn As ADODB.Connection
Set Conn = New ADODB.Connection
Conn.ConnectionString = "DSN=InventorBOM"
Conn.Open

'Record set
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer


'Check to see if the material exist in the `Products` table

rs.Open "SELECT * FROM `PRODUCTS` WHERE `DrawingFileName` = CONVERT( _utf8 '" & Fabrication_Material & "' USING latin1 )COLLATE latin1_swedish_ci LIMIT 0, 30 ", Conn

If (rs.BOF And rs.EOF) Then
    
    'insert the Material INFO into the product table
     Conn.Execute "INSERT INTO `PRODUCTS` (`ProductID` , `DrawingFileName` , `ProductName` , `ProductDescription` , `FieldAssembly`,`DwgPath`,`TimeStamp` )    VALUES ('" & Fabrication_Material & "' , '" & Fabrication_Material & "' , '" & Fab_Prod_Name & "' , Null , Null , Null,  NOW( ) );"

Else
    'check if there is any diff
    'delete record,
    'then insert new record w/ probably updated record fields
    
End If

'close the record
rs.Close

'close the active part doc
oPartDoc.Close


'==========Switch to IDW doc================

'Define and set the drawing doc
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
                      
'Define part list object
Dim oPartList As PartsList
Set oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)

'Define the row object
Dim oRow As PartsListRow
Set oRow = oPartList.PartsListRows.Item(1)

'Define the cell object
Dim oCell_Drawing_Name As PartsListCell
Set oCell_Drawing_Name = oRow.Item(5)
            
Dim oCell_PID As PartsListCell
Set oCell_PID = oRow.Item(3)
            
Dim oCell_Description As PartsListCell
Set oCell_Description = oRow.Item(4)
             
Dim oCell_QTY As PartsListCell
Set oCell_QTY = oRow.Item(2)
                                                               

'Write PID to the Product ID cell in PL
oCell_PID.Value = Fabrication_Material
                    
'Write the Description to description cell in PL
oCell_Description.Value = Fab_Prod_Name
                     
'Write the Fabrication QTY
oCell_QTY.Value = Fab_QTY_INT
                                          
'Override the drawing file name field w/ Fab_Material name
oCell_Drawing_Name.Value = Fabrication_Material
                         
                         
'Allocate latest DY #

'SQL query, Sort...

rs.Open "SELECT * FROM `PRODUCTS` WHERE `ProductID` LIKE CONVERT( _utf8 '%#DY09%'USING latin1 ) COLLATE latin1_swedish_ci ORDER BY `ProductID` DESC LIMIT 0 , 30", Conn

'Latest DY string from my MySQL query
Dim LatestDY As String

'Sub string in the #DY string
Dim LatestDY_Sub As String

'Need to conver the sub string to value type
Dim LatestDY_Value As Integer

'The we need to combine strings into a new #DY09-xxx_1 format
Dim NewDY As String

'Fomart new DY
Dim NewDY_Fomat As String


'Take it from Recordset
LatestDY = rs!ProductID

'Get the sub string
LatestDY_Sub = Mid(LatestDY, 6, 3)

'Convert sub string to value
LatestDY_Value = CInt(LatestDY_Sub)

'Increment it byt +1
NewDY = LatestDY_Value + 1

'Fomatted final new #DY, need to pass it to iProp
NewDY_Format = "#DY09-" & NewDY & "_1"



'Define and setup drawing i-Prop to store latesst #DY automatically
Dim oDrawPropSet As PropertySets
Set oDrawPropSet = oDrawDoc.PropertySets

'Set the value of the Drawing doc' iProp's `Part Number` field.
oDrawPropSet.Item(3).Item(2).Expression = NewDY_Format

'Save Doc to save iProp change
oDrawDoc.Save

'Insert the # DY into the `PRODUCTS` table

'check if it exists,
'if it does, check DIFF, delete if there is change




'Inser the #DY, Fabrication, QTY into the `PRODUCT DETTAILS` table
'This is the same logic as assembly


MsgBox ("Sucessful. Please click the button")

rs.Close
Conn.Close

End Sub

Private Sub CommandButton2_Click()

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

'Open the MySQL databse 'bom'
Dim Conn As ADODB.Connection
Set Conn = New ADODB.Connection
Conn.ConnectionString = "DSN=InventorBOM"
Conn.Open

'Setup a Recordset that holds a set of records from MySQL table
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer


' Set a reference to the first part list
      Dim oPartList As PartsList
      Set oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)

    ' Iterate through the contents of the parts list. i is row number
      Dim i As Long
    
      For i = 1 To oPartList.PartsListRows.Count
         ' Set the current row i.
          Dim oRow As PartsListRow
          Set oRow = oPartList.PartsListRows.Item(i)
        
            ' Setup cell for Xref Drawing File Name (Column=5)
              Dim oCell_Drawing_Name As PartsListCell
              Set oCell_Drawing_Name = oRow.Item(5)
            
            'Setup cell for PID (Column=3)
              Dim oCell_PID As PartsListCell
              Set oCell_PID = oRow.Item(3)
            
            'Setup cell for ProductName (Column=4)
              Dim oCell_Description As PartsListCell
              Set oCell_Description = oRow.Item(4)
                                                                       
            'Define the names of the strings
             Dim xrefstring As String
             Dim PID As String
             Dim Description As String
                        
            'Pass the xref drawing name from PL to VB
             xrefstring = oCell_Drawing_Name.Value
                       
                               
            'Find the record where the drawing file name matches the one in Inventor top-level assmebly
            'The below statement does not give error message if there is no record in DB
             rs.Open "SELECT * FROM `PRODUCTS` WHERE `DrawingFileName` = CONVERT( _utf8 '" & xrefstring & "' USING latin1 )COLLATE latin1_swedish_ci LIMIT 0, 30 ", Conn
                
                If Not (rs.BOF And rs.EOF) Then
                    PID = rs!ProductID
                    Description = rs!ProductName
                    oCell_PID.Value = PID
                    oCell_Description.Value = Description
                   
                Else
                    
                   ' Just do nothing, cell value remain unchanged.
                                      
                End If
                
               rs.Close
                                       
       Next
   
'close the conenction to MySQL
Conn.Close

'activate the drawing doc focus
oDrawDoc.Activate

'Update the drawing, recompute all
oDrawDoc.Update

'Save the drawing doc, make drawing file in sync.
oDrawDoc.Save



End Sub

Private Sub CommandButton3_Click()

 Dim oDrawDoc As DrawingDocument
 Set oDrawDoc = ThisApplication.ActiveDocument

'Open the MySQL databse
 Dim Conn As ADODB.Connection
 Set Conn = New ADODB.Connection
 Conn.ConnectionString = "DSN=InventorBOM"
 Conn.Open
 
'Define the names of string VAR
Dim PRODUCT_ASMB_ID As String
Dim SUB_ASMB_ITEM_ID As String
Dim PRDT_QTY As String
Dim PRDT_ID As String

'Get Assembly ID from Title Block
Dim Inventor_TB As TitleBlock
Set Inventor_TB = oDrawDoc.ActiveSheet.TitleBlock
Dim Inventor_TBDef As TitleBlockDefinition
Set Inventor_TBDef = oDrawDoc.TitleBlockDefinitions.Item(3)
Dim oTextbox As TextBox
Set oTextbox = Inventor_TBDef.Sketch.TextBoxes.Item(11)

'you can query, but can not set
PRODUCT_ASMB_ID = oTextbox.Text
'or you can use the following
'PRODUCT_ASMB_ID = Inventor_TB.GetResultText(oTextbox)

Dim new_dy As String
new_dy = "from code"

'try to set this text format override to textbox in TB_Def
Dim sText As String
sText = "<StyleOverride FontSize='.75'>TITLE BLOCK</StyleOverride>"


'you can not set it
'oTextbox.Text = new_dy
'Prompt text is just to display, no help for this program
'Call Inventor_TB.SetPromptResultText(oTextbox, new_dy)
'Dim oSketch As DrawingSketch
'Call Inventor_TBDef.Edit(oSketch)
'PRODUCT_ASMB_ID = oTextbox.Text
'still can not set in a sketch edit mode
'=====oTextbox.Text = new_dy===why this does not work?


'get the assembly ID from drawing iProp





            
'Define new recordset object
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer

'Check if the assembly ID exists
rs.Open "SELECT * FROM `PRODUCT_DETAILS` WHERE `AssemblyID` = CONVERT( _utf8 '" & PRODUCT_ASMB_ID & "' USING latin1 )COLLATE latin1_swedish_ci LIMIT 0, 30 ", Conn

'Setup the part list, row, cells
      Dim oPartList As PartsList
      Set oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(1)
      Dim oRow As PartsListRow
      Dim oCell_QTY As PartsListCell
      Dim oCell_PID As PartsListCell
      Dim i As Long
      Dim SQL_ITEM As Integer
      
      
If (rs.BOF And rs.EOF) Then
      
      SQL_ITEM = 0
      For i = 1 To oPartList.PartsListRows.Count
          
          Set oRow = oPartList.PartsListRows.Item(i)
          Set oCell_QTY = oRow.Item(2)
          Set oCell_PID = oRow.Item(3)
                
              If Not (oCell_QTY.Value = 0) Then
                 SQL_ITEM = SQL_ITEM + 1
                 SUB_ASMB_ITEM_ID = SQL_ITEM
                 PRDT_QTY = oCell_QTY.Value
                 PRDT_ID = oCell_PID.Value
                 Conn.Execute "INSERT INTO `PRODUCT_DETAILS` (`AssemblyID` , `ItemNumber` , `Quantity` , `ProductID` , `TimeStamp` )    VALUES ('" & PRODUCT_ASMB_ID & "' , '" & SUB_ASMB_ITEM_ID & "' , '" & PRDT_QTY & "' , '" & PRDT_ID & "', NOW( ) );"
               
               Else
                 'Do nothing
               End If
                      
      Next
    


Else
     'Delete the exisiting records
     Conn.Execute "DELETE FROM `PRODUCT_DETAILS` WHERE `AssemblyID` = '" & PRODUCT_ASMB_ID & "' ; "
     'Insert new records
     SQL_ITEM = 0
          
     For i = 1 To oPartList.PartsListRows.Count
               
          Set oRow = oPartList.PartsListRows.Item(i)
          Set oCell_QTY = oRow.Item(2)
          Set oCell_PID = oRow.Item(3)
          
          
          If Not (oCell_QTY.Value = 0) Then
              SQL_ITEM = SQL_ITEM + 1
              SUB_ASMB_ITEM_ID = SQL_ITEM
              PRDT_QTY = oCell_QTY.Value
              PRDT_ID = oCell_PID.Value
              Conn.Execute "INSERT INTO `PRODUCT_DETAILS` (`AssemblyID` , `ItemNumber` , `Quantity` , `ProductID` , `TimeStamp` )    VALUES ('" & PRODUCT_ASMB_ID & "' , '" & SUB_ASMB_ITEM_ID & "' , '" & PRDT_QTY & "' , '" & PRDT_ID & "', NOW( ) );"
                 
          Else
            'Do nothing
          End If
                      
     Next


End If

Conn.Close
MsgBox ("MySQL BOM has been sucessfully updated")

End Sub


Private Sub CommandButton4_Click()

Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.ActiveDocument

Dim COMP_PID As String
Dim Prod_Name As String

Dim oPropSets As PropertySets
Set oPropSets = oPartDoc.PropertySets

'part number field in iProp, get the drawing name
COMP_PID = oPropSets.Item(3).Item(2).Expression
'product name field in custom iProp
Prod_Name = oPropSets.Item("User Defined Properties").Item("Product_Name").Expression

Dim Conn As ADODB.Connection
Set Conn = New ADODB.Connection
Conn.ConnectionString = "DSN=InventorBOM"
Conn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer

rs.Open "SELECT * FROM `PRODUCTS` WHERE `DrawingFileName` = CONVERT( _utf8 '" & COMP_PID & "' USING latin1 )COLLATE latin1_swedish_ci LIMIT 0, 30 ", Conn

'If it's new record, then just insert it.
If (rs.BOF And rs.EOF) Then

    Conn.Execute "INSERT INTO `PRODUCTS` (`ProductID` , `DrawingFileName` , `ProductName` , `ProductDescription` , `FieldAssembly`,`DwgPath`,`TimeStamp` )    VALUES ('" & COMP_PID & "' , '" & COMP_PID & "' , '" & Prod_Name & "' , Null , Null , Null,  NOW( ) );"
    rs.Close

Else
    
    'maybe delete and then insert the updated record again
     rs.Close
    
End If

Conn.Close

End Sub

Private Sub UserForm_Click()

End Sub

[#2]

Hi,

firstly, could you clarify what the issue others told you that "the macro cannot work on 2012/2013"? I'd suggest you try in Inventor 2012/2013 to test if it really works or not and provide any error you get. Otherwise, I am afriad it is hard for any peers here to jump into with the long code, connecting with the database. From this perspective, a simplified code would be more helpful to diagnose the problem. 

I do not see a big change of the relevant Inventor API in 2012/2013. You can still get iProperties, Paramters, PartsList Table info as you did in the past. As to MySQL, Inventor just uses the API of MS. And your code just read/write the table in the database. I do not either think there are many changes that you need to modify.

I understand you are not a programmer, but it is really important to isolate the problem in order to get a feedback, instead of posting all codes and requesting a debugging to make it work. Thanks for understanding.

Again, I still suggest you try with the code firstly at your side and provide the error you get. Please do remember to submit some neccessary snapshots.

[#3]

Hi,

I keep finding code that uses this line

"Dim Conn As ADODB.Connection"

All of the code is aged and older, so I'm assuming there was older inventor VBA programs used.

The issue arises when debugging where the error message say this....

"Compile error: User-defined type not defined"

....and proceed to highlight the ADODB.Connection type.

I'm assuming this is the issue, and unsure as to how to go about fixing this, any help?

Thanks

Mitch

[#4]

Found the error, 

Need to provide a reference to Microsoft ActiveX Object 

Regards

Mitch

[#5]

Thanks mhatfield 's comment. Hope it helps terry.gonzales in this case.

[#6]

Thanks guys, I understand this wasn't the best approach for me to copy all this code to the forum. I just had no way to even begin understanding this. I believe the issue that we were told about is that this version of VBA is older and will not be supported in the near future. So, we thought that we needed to recreate this code using the newer version of VBA. I don't know how valid this is or not.

Ideally, we need something like this to work with both Inventor and Autocad. Much of what we do is a combination of both mechanical assemblies best suited for Inventor and large equipment layouts with civil work more suited for Autocad. I certainly don't expect to get anything for free so if anyone can help us out, I'm sure we can work our suitable compensation.

Thanks,

Terry

[#7]

I'm interested.

[#8]

HI sorry but we have already resolved this issue. -- Terry Gonzales Project Engineer InterClean Equipment, Inc. Tel. +1 734-975-2967 x218 InterClean - Member of Tammermatic Group