Inventor VBA 实例与大家分享 欢迎大家参与提问 更加希望二次开发的前辈多多指教 ... ...

Inventor 设计软件在我们中国使用的不是很广,其中VBA方面的书籍很难找到,朋友们不要保守,跟帖说说你们的心得,有好主意拿出来大家分享共同进步！谢谢大家的关注！！！
对Inventor VBA不是很熟的朋友 想要看VBA帮助的话 我想都会和我当初一样找不到范例 按下F1 帮助键 只看到 Visual Basic 参考 ！！如何看 如何学习？？？ 大家可能都会觉得没有头绪？？
后面我会告诉大家如何看VBA帮助


'读取现有图纸数量
Public Sub countDrawingSheets()
Dim oDrawDoc As DrawingDocument
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawDoc = ThisApplication.ActiveDocument
Debug.Print "Number of Sheets = " & oDrawDoc.Sheets.Count
End If
End Sub
'删除多余的图框
Public Sub getBorderNames()
Dim oDrawDoc As DrawingDocument
'Ensure the active document is a drawing
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oBorders As BorderDefinitions
Dim oBorderDef As BorderDefinition
Set oBorders = oDrawDoc.BorderDefinitions
'loop through the border collection and print out then
' name of each border
For Each oBorderDef In oBorders
Debug.Print oBorderDef.Name
On Error Resume Next
oBorderDef.Delete
Next oBorderDef
End If
End Sub
'增加标题栏
Public Sub addMyTitleBlock()
Dim oDrawDoc As DrawingDocument
'Ensure the active document is a drawing
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
Set oDrawDoc = ThisApplication.ActiveDocument
' get the Title blocks (definitions)
Dim oTitleBlks As TitleBlockDefinitions
Set oTitleBlks = oDrawDoc.TitleBlockDefinitions
' add a new title block definition
Dim oTitleBlk As TitleBlockDefinition
Set oTitleBlk = oTitleBlks.Add("myxTitleBlock")
End If
End Sub
'增加图框
Public Sub Demo23_CreateBorderDefinition()
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
' Create the new border definition.
Dim oBorderDef As BorderDefinition
Set oBorderDef = oDrawDoc.BorderDefinitions.Add("My Border")
' Open the border definition's sketch for edit. This is done by calling the Edit
' method of the BorderDefinition to obtain a DrawingSketch. This actually creates
' a copy of the border definition's and opens it for edit.
Dim oSketch As DrawingSketch
Call oBorderDef.Edit(oSketch)
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
' Use the functionality of the sketch to add geometry.
Call oSketch.SketchLines.AddAsTwoPointRectangle(oTG.CreatePoint2d(2, 2), _
oTG.CreatePoint2d(25.94, 19.59))
Call oBorderDef.ExitEdit(True)
End Sub
'增加缩略符号
Public Sub Demo23_CreateSketchedSymbolDefinition()
' Set a reference to the drawing document.
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
&#39; Create the new sketched symbol definition.
Dim oSketchedSymbolDef As SketchedSymbolDefinition
Set oSketchedSymbolDef = oDrawDoc.SketchedSymbolDefinitions.Add("Circular Callout")
&#39; Open the sketched symbol definition&#39;s sketch for edit. This is done by calling the Edit
&#39; method of the SketchedSymbolDefinition to obtain a DrawingSketch. This actually creates
&#39; a copy of the sketched symbol definition&#39;s and opens it for edit.
Dim oSketch As DrawingSketch
Call oSketchedSymbolDef.Edit(oSketch)
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
&#39; Use the functionality of the sketch to add sketched symbol graphics.
Dim oSketchLine As SketchLine
Set oSketchLine = oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, 0), oTG.CreatePoint2d(20, 0))
Dim oSketchCircle As SketchCircle
Set oSketchCircle = oSketch.SketchCircles.AddByCenterRadius(oTG.CreatePoint2d(22, 0), 2)
Call oSketch.GeometricConstraints.AddCoincident(oSketchLine.EndSketchPoint, oSketchCircle)
&#39; Make the starting point of the sketch line the insertion point
oSketchLine.StartSketchPoint.InsertionPoint = True
&#39; Add a prompted text field at the center of the sketch circle.
Dim sText As String
sText = "<StyleOverride FontSize=&#39;1&#39;>&ltrompt>Enter text 1</Prompt></StyleOverride>"
Dim oTextBox As TextBox
Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(22, 0), sText)
oTextBox.VerticalJustification = kAlignTextMiddle
oTextBox.HorizontalJustification = kAlignTextCenter
Call oSketchedSymbolDef.ExitEdit(True)
End Sub
&#39;增加已经有的缩略符号的基础上加上字符标志以及角度等信息
Public Sub Demo23_InsertSketchedSymbolOnSheet()
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
&#39; Set a reference to the drawing document.
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
&#39; Obtain a reference to the desired sketched symbol definition.
Dim oSketchedSymbolDef As SketchedSymbolDefinition
Set oSketchedSymbolDef = oDrawDoc.SketchedSymbolDefinitions.Item("Circular Callout")
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
&#39; This sketched symbol definition contains one prompted string input. An array
&#39; must be input that contains the strings for the prompted strings.
Dim sPromptStrings(0) As String
sPromptStrings(0) = "A"
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
&#39; Add an instance of the sketched symbol definition to the sheet.
&#39; Rotate the instance by 45 degrees and scale by .75 when adding.
&#39; The symbol will be inserted at (0,0) on the sheet. Since the
&#39; start point of the line was marked as the insertion point, the
&#39; start point should end up at (0,0).
Dim oSketchedSymbol As SketchedSymbol
Set oSketchedSymbol = oSheet.SketchedSymbols.Add(oSketchedSymbolDef, _
oTG.CreatePoint2d(5, 5), _
(3.14159 / 4), _
0.75, sPromptStrings)
End Sub
&#39;增加图框
Public Sub InsertCustomBorderOnSheet()
    &#39; Set a reference to the drawing document.
    &#39; This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
   
    &#39; Obtain a reference to the desired border definition.
    Dim oBorderDef As BorderDefinition
    Set oBorderDef = oDrawDoc.BorderDefinitions.Item("11 x 17 Border")
    MsgBox oBorderDef.Name
   
    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
   
    &#39; Check to see if the sheet already has a border and delete it if it does.
    If Not oSheet.Border Is Nothing Then
        oSheet.Border.Delete
    End If
   
    &#39; This border definition contains one prompted string input.  An array
    &#39; must be input that contains the strings for the prompted strings.
    Dim sPromptStrings(1 To 1) As String
    sPromptStrings(1) = "This is the input for the prompted text."
   
    &#39; Add an instance of the border definition to the sheet.
    Dim oBorder As Border
    Set oBorder = oSheet.AddBorder(oBorderDef, sPromptStrings)
End Sub
&#39;增加一张新的图纸并且放入指定的标题栏
Public Sub Demo23_addSheetAddBorder()
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
&#39; Get the Drawing document
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
&#39; Get the Sheets collection
Dim oSheets As Sheets
Set oSheets = oDrawDoc.Sheets
Dim oSheet As Sheet
For Each oSheet In oSheets
Debug.Print oSheet.Name
Next oSheet
&#39; Add a new sheet with a default border and a Title block
Set oSheet = oSheets.Add(kA3DrawingSheetSize, kDefaultPageOrientation, "Sheet")
Call oSheet.AddBorder(oDrawDoc.BorderDefinitions.Item("11 x 17 Border"))
Call oSheet.AddTitleBlock(oDrawDoc.TitleBlockDefinitions("11 x 17 Titleblock "))
End Sub
&#39;出图 普通出图
Public Sub Demo23_AddViews()
&#39; Open the model to create a view
Dim oPartDoc As PartDocument
Set oPartDoc = ThisApplication.Documents.Open("C:Temp.ipt", False)
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
&#39; Create the base view.
Dim oFrontView As DrawingView
Set oFrontView = oSheet.DrawingViews.AddBaseView(oPartDoc, oTG.CreatePoint2d(15, 5), 1 / 8, _
kFrontViewOrientation, kHiddenLineDrawingViewStyle)
&#39; close the part file
oPartDoc.Close
&#39; Create projected views.
Dim oRightView As DrawingView
Set oRightView = oSheet.DrawingViews.AddProjectedView(oFrontView, oTG.CreatePoint2d(15, 15), kFromBaseDrawingViewStyle)
Dim oLeftView As DrawingView
Set oLeftView = oSheet.DrawingViews.AddProjectedView(oFrontView, oTG.CreatePoint2d(30, 5), kFromBaseDrawingViewStyle)
Dim oIsoView As DrawingView
Set oIsoView = oSheet.DrawingViews.AddProjectedView(oFrontView, oTG.CreatePoint2d(27, 21), kHiddenLineRemovedDrawingViewStyle)
End Sub
&#39;不知道干嘛用的
Sub drawCurvesIterate()
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
Dim oDrawDoc As DrawingDocument
Dim i As Integer
Dim oSheet As Sheet
Dim oDrawView As DrawingView
Set oDrawDoc = ThisApplication.ActiveDocument
Set oSheet = oDrawDoc.ActiveSheet
For Each oDrawView In oSheet.DrawingViews
Dim oDrawViewCurves As DrawingCurvesEnumerator
Set oDrawViewCurves = oDrawView.DrawingCurves()
Debug.Print "Number of Entities in " & oDrawView.Name & " " & oDrawViewCurves.Count
Dim oDrawCurve As DrawingCurve
For i = 1 To oDrawViewCurves.Count
Set oDrawCurve = oDrawViewCurves.Item(i)
Select Case oDrawCurve.CurveType
Case kUnknownCurve:
Debug.Print "Unknown curve type."
Case kLineCurve:
Debug.Print "Line curve."
Case kLineSegmentCurve
Debug.Print "Line segment curve."
Case kCircleCurve
Debug.Print "Circular curve."
Case kCircularArcCurve
Debug.Print "Circular arc curve."
Case kEllipseFullCurve
Debug.Print "Ellipse full curve."
Case kEllipticalArcCurve
Debug.Print "Elliptical arc curve."
Case kBSplineCurve
Debug.Print "B-spline curve."
End Select
Next
Next

&#39;Dim oDrawCurve As DrawingCurve
&#39;Set oDrawCurve = oDrawCurvesEnumerator(1)
&#39; Iterate through the curves in the enumerator
&#39;For Each oDrawCurve In oDrawCurvesEnumerator
&#39; Get the Geometry intent for the drawing curve
&#39;Dim oGeometryIntent As GeometryIntent
&#39;Set oGeometryIntent = oSheet.CreateGeometryIntent(oDrawCurve)
&#39;Print out the IntentType
&#39;Debug.Print oGeometryIntent.IntentType
&#39;Next oDrawCurve
End Sub
&#39;创建局部放大图
Public Sub CreateDetailView()
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
&#39; Check to make sure a drawing view is selected.
If Not TypeOf oDrawDoc.SelectSet.Item(1) Is DrawingView Then
MsgBox "A drawing view must be selected."
Exit Sub
End If
&#39; Set a reference to the selected drawing. This assumes
&#39; that the selected view is not a draft view.
Dim oDrawingView As DrawingView
Set oDrawingView = oDrawDoc.SelectSet.Item(1)
&#39; Set a reference to the center of the base view.
Dim oPoint As Point2d
Set oPoint = oDrawingView.Center
&#39; Translate point by a distance = 2 * width of the view
&#39; This will be the placement point of the detail view.
oPoint.X = oPoint.X + 2 * oDrawingView.Width
&#39; Set corner one of rectangular fence as
&#39; the left‐bottom corner of the base view.
Dim oCornerOne As Point2d
Set oCornerOne = oDrawingView.Center
oCornerOne.X = oCornerOne.X - oDrawingView.Width / 2
oCornerOne.Y = oCornerOne.Y - oDrawingView.Height / 2
&#39; Set corner two of rectangular fence as
&#39; the center of the base view.
Dim oCornerTwo As Point2d
Set oCornerTwo = oDrawingView.Center
&#39; Get any linear curve from the base view
Dim oCurve As DrawingCurve &#39; DrawingViewCurve
For Each oCurve In oDrawingView.DrawingCurves &#39; .DrawingViewCurves
Debug.Print oCurve.CurveType
If oCurve.CurveType = kLineSegmentCurve Then
Exit For
End If
Next
&#39; Create an intent object
Dim oAttachPoint As GeometryIntent
Set oAttachPoint = oSheet.CreateGeometryIntent(oCurve, kStartPointIntent)
&#39; Create the detail view
Dim oDetailView As DetailDrawingView
Set oDetailView = oSheet.DrawingViews.AddDetailView(oDrawingView, oPoint, _
kFromBaseDrawingViewStyle, False, oCornerOne, oCornerTwo, oAttachPoint, 2)
End Sub
&#39;增加自定义标注
Public Sub addMyDimension()
If ThisApplication.ActiveDocument.DocumentType <> kDrawingDocumentObject Then Exit Sub
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim oSelectSet As SelectSet
Set oSelectSet = oDrawDoc.SelectSet
Dim oTG As TransientGeometry
Set oTG = ThisApplication.TransientGeometry
&#39; Test to see if one entity is selected
If oSelectSet.Count = 1 Then
&#39;Test to see if the selected entity is a sketch line
Dim oObj As Object
Set oObj = oSelectSet.Item(1)
If TypeOf oSelectSet.Item(1) Is DrawingCurveSegment Then
Dim oDrawCurveSegment As DrawingCurveSegment
Set oDrawCurveSegment = oSelectSet(1)
Dim oDrawingCurve As DrawingCurve
Set oDrawingCurve = oDrawCurveSegment.Parent
Dim oGeomIntent1 As GeometryIntent
Dim oGeomIntent2 As GeometryIntent
Set oGeomIntent1 = oSheet.CreateGeometryIntent(oDrawingCurve, kStartPointIntent)
Set oGeomIntent2 = oSheet.CreateGeometryIntent(oDrawingCurve, kEndPointIntent)
&#39; Add a linear dimension
Dim oGenDims As GeneralDimensions
Set oGenDims = oSheet.DrawingDimensions.GeneralDimensions
Dim oLinDim As LinearGeneralDimension
Set oLinDim = oGenDims.AddLinear(oTG.CreatePoint2d(10, 10), oGeomIntent1, oGeomIntent2)
End If
End If
End Sub
&#39;增加工程图资源中的自定义图框
Public Sub CreateBorderDefinition()
    &#39; Set a reference to the drawing document.
    &#39; This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument
   
    &#39; Create the new borderdefinition.
    Dim oBorderDef As BorderDefinition
    Set oBorderDef = oDrawDoc.BorderDefinitions.Add("Sample Border")
   
    &#39; Open the border definition&#39;s sketch for edit.  This is done by calling the Edit
    &#39; method of the BorderDefinition to obtain a DrawingSketch.  This actually creates
    &#39; a copy of the border definition&#39;s and opens it for edit.
    Dim oSketch As DrawingSketch
    Call oBorderDef.Edit(oSketch)
   
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry
   
    &#39; Use the functionality of the sketch to add geometry.
    Call oSketch.SketchLines.AddAsTwoPointRectangle(oTG.CreatePoint2d(2, 2), oTG.CreatePoint2d(25.94, 19.59))
    Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(0, 10.795), oTG.CreatePoint2d(2, 10.795))
    Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(13.97, 0), oTG.CreatePoint2d(13.97, 2))
    Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(25.94, 10.795), oTG.CreatePoint2d(27.94, 10.795))
    Call oSketch.SketchLines.AddByTwoPoints(oTG.CreatePoint2d(13.97, 19.59), oTG.CreatePoint2d(13.97, 21.59))
   
    &#39; Add some text to the border.
    Dim oTextBox As TextBox
    Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(2, 1), "Here is a sample string")
    oTextBox.VerticalJustification = kAlignTextMiddle
   
    &#39; Add some prompted text to the border.
    Set oTextBox = oSketch.TextBoxes.AddFitted(oTG.CreatePoint2d(2, 20.59), "Enter designers name:")
    oTextBox.VerticalJustification = kAlignTextMiddle
   
    Call oBorderDef.ExitEdit(True)
End Sub

告诉大家在 VBA编辑器中 选中Application 然后选中后 再按F1  看到的全英文的界面 标题为："Autodesk Inventor 版本 COM API Reference"
跟之前看到的是不是不一样了 在搜索框中输入Example 看看，有500 范例 慢慢学习研究吧! 有了心得 记得回来看看 发表些自己的想法！！

在使用CNC 编程使用模型导出成ＤＸＦ文件时这段代码帮了我很大的忙　原来我使用模型　转成钣金后　再用导出副本为　对话框设置等一系列操作才能够完成　现在只要　点一次鼠标操作即可完成所有操作！太棒了！
Public Sub WriteSheetMetalDXF()

    &#39; Get the active document.  This assumes it is a part document.
    Dim oDoc As PartDocument
    Set oDoc = ThisApplication.ActiveDocument

    &#39; Get the DataIO object.
    Dim oDataIO As DataIO
    Set oDataIO = oDoc.ComponentDefinition.DataIO

    &#39; Build the string that defines the format of the DXF file.
    Dim sOut As String
    sOut = "FLAT PATTERN DXF?AcadVersion=R12&OuterProfileLayer=Outer"

    &#39; Create the DXF file.
    oDataIO.WriteDataToFile sOut, "C:tempflat2.dxf"
End Sub

&#39;FX表编辑操作
Public Sub ModelParameters()
    &#39; Obtain the active document, this assumes
    &#39; that a part document is active in Inventor.
    Dim oPartDoc As Inventor.PartDocument
    Set oPartDoc = ThisApplication.ActiveDocument
    &#39; Obtain the Parameters collection
    Dim oParams As Parameters
    Set oParams = oPartDoc.ComponentDefinition.Parameters
    &#39; Iterate through the Parameters collection to obtain
    &#39; information about the Parameters
    Dim iNumParams As Long
    Debug.Print "ALL PARAMETERS"
    For iNumParams = 1 To oParams.Count
        &#39;Display the Name
        Debug.Print " Name: " & oParams.Item(iNumParams).Name
        
        &#39;Display the Parameter Type
        Select Case oParams.Item(iNumParams).Type
            Case kModelParameterObject
                Debug.Print "  Type: " & "Model Parameter"
            Case kTableParameterObject
                Debug.Print "  Type: " & "Table Parameter"
            Case kUserParameterObject
                Debug.Print "  Type: " & "User Parameter"
        End Select
         
        &#39;Display the Value
        Debug.Print "  Value: " & oParams.Item(iNumParams).Value
        
        &#39;Display the Health Status
        Select Case oParams.Item(iNumParams).HealthStatus
            Case kDeletedHealth
                Debug.Print "  Health Status: " & "Deleted"
            Case kDriverLostHealth
                Debug.Print "  Health Status: " & "Driver Lost"
            Case kInErrorHealth
                Debug.Print "  Health Status: " & "In Error"
            Case kOutOfDateHealth
                Debug.Print "  Health Status: " & "Out of Date"
            Case kUnknownHealth
                Debug.Print "  Health Status: " & "Unknown"
            Case kUpToDateHealth
                Debug.Print "  Health Status: " & "Up to Date"
        End Select
    Next iNumParams
     
    &#39; Obtain the Model Parameters collection
    Dim oModelParams As ModelParameters
    Set oModelParams = oParams.ModelParameters
   
    &#39; Iterate through the Model Parameters collection
    Dim iNumModelParams As Long
    Debug.Print "MODEL PARAMETER VALUES"
    For iNumModelParams = 1 To oModelParams.Count
        &#39; Display the Name
        Debug.Print " Name:" & oModelParams.Item(iNumModelParams).Name
        
        &#39; Display the Value
        Debug.Print "  Value: " & oModelParams.Item(iNumModelParams).Value
        
        &#39; Display the units
        Debug.Print "  Units: " & oModelParams.Item(iNumModelParams).Units
      
        &#39; Change the Model Parameter values
        oModelParams.Item(iNumModelParams).Value = oModelParams.Item(iNumModelParams).Value * 2
    Next iNumModelParams
   
    &#39; Accessing a particular parameter if you know its name, the user and reference parameters can also be accessed in a similar way
    oModelParams.Item("d0").Name = "NewParam"
   
    &#39; Change the value of the newly named parameter "param1"
    oModelParams.Item("NewParam").Value = 25
   
    &#39; Update the model.
    oPartDoc.Update
End Sub

Public Sub testModelParameters()
    &#39; Obtain the active document, this assumes
    &#39; that a part document is active in Inventor.
    Dim oPartDoc As Inventor.PartDocument
    Set oPartDoc = ThisApplication.ActiveDocument
    &#39; Obtain the Parameters collection
    Dim oParams As Parameters
    Set oParams = oPartDoc.ComponentDefinition.Parameters
    &#39; Iterate through the Parameters collection to obtain
    &#39; information about the Parameters
    Dim iNumParams As Long
    Debug.Print "ALL PARAMETERS"
    For iNumParams = 1 To oParams.Count
        &#39;Display the Name
        Debug.Print " Name: " & oParams.Item(iNumParams).Name
        
        &#39;Display the Parameter Type
        Select Case oParams.Item(iNumParams).Type
            Case kModelParameterObject
                Debug.Print "  Type: " & "Model Parameter"
            Case kTableParameterObject
                Debug.Print "  Type: " & "Table Parameter"
            Case kUserParameterObject
                Debug.Print "  Type: " & "User Parameter"
        End Select
         
        &#39;Display the Value
        Debug.Print "  Value: " & oParams.Item(iNumParams).Value
        
        &#39;Display the Health Status
        Select Case oParams.Item(iNumParams).HealthStatus
            Case kDeletedHealth
                Debug.Print "  Health Status: " & "Deleted"
            Case kDriverLostHealth
                Debug.Print "  Health Status: " & "Driver Lost"
            Case kInErrorHealth
                Debug.Print "  Health Status: " & "In Error"
            Case kOutOfDateHealth
                Debug.Print "  Health Status: " & "Out of Date"
            Case kUnknownHealth
                Debug.Print "  Health Status: " & "Unknown"
            Case kUpToDateHealth
                Debug.Print "  Health Status: " & "Up to Date"
        End Select
    Next iNumParams
     
    &#39; Obtain the Model Parameters collection
    Dim oModelParams As ModelParameters
    Set oModelParams = oParams.ModelParameters
   
    &#39; Iterate through the Model Parameters collection
    Dim iNumModelParams As Long
    Debug.Print "MODEL PARAMETER VALUES"
    For iNumModelParams = 1 To oModelParams.Count
        &#39; Display the Name
        Debug.Print " Name:" & oModelParams.Item(iNumModelParams).Name
        
        &#39; Display the Value
        Debug.Print "  Value: " & oModelParams.Item(iNumModelParams).Value
        
        &#39; Display the units
        Debug.Print "  Units: " & oModelParams.Item(iNumModelParams).Units
      
        &#39; Change the Model Parameter values
        oModelParams.Item(iNumModelParams).Value = oModelParams.Item(iNumModelParams).Value * 2
    Next iNumModelParams
   
    &#39; Accessing a particular parameter if you know its name, the user and reference parameters can also be accessed in a similar way
    oModelParams.Item("d0").Name = "NewParam"
   
    &#39; Change the value of the newly named parameter "param1"
    oModelParams.Item("NewParam").Value = 25
   
    &#39; Update the model.
    oPartDoc.Update
End Sub

Public Sub TableParameters()
    Dim oPartDoc As Inventor.Document
   
    &#39; Obtain the active document, this assumes that
    &#39; a part document is active in Inventor
    Set oPartDoc = ThisApplication.ActiveDocument
   
    &#39;Obtain the Parameters collection
    Dim oParams As Parameters
    Set oParams = oPartDoc.ComponentDefinition.Parameters
   
    &#39; Add a parameter table using an existing spreadsheet.
    oParams.ParameterTables.AddExcelTable "C:Tempparams.xls", "A1", True
   
    &#39; Accessing a parameters in a linked/embedded file
    Dim oParamTableFiles As ParameterTables
    Set oParamTableFiles = oParams.ParameterTables
   
    &#39; Traverse through the collection of linked files
    Dim oParamTableFile As ParameterTable
    For Each oParamTableFile In oParamTableFiles
        &#39; Change the linked file to another file
        If LCase(oParamTableFile.Filename) = "C:tempparams.xls" Then
            oParamTableFile.Filename = "C:Tempnewparams.xls"
        End If
        &#39; Get the Parameters collection from the file
        Dim oTableParams As TableParameters
        Set oTableParams = oParamTableFile.TableParameters
     
        &#39; Traverse through the table parameters collection and display them
        Dim iNumTableParams As Long
        Debug.Print "TABLE PARAMETER VALUES"
        For iNumTableParams = 1 To oTableParams.Count
            &#39; Display the name
            Debug.Print " Name: " & oTableParams.Item(iNumTableParams).Name
            
            &#39; Display the expression
            Debug.Print " Expression: " & oTableParams.Item(iNumTableParams).Expression
        
            &#39; Display the value.  This will be in database units.
            Debug.Print " Value: " & oTableParams.Item(iNumTableParams).Value
        Next iNumTableParams
    Next
End Sub
Public Sub CreateParametersAndGroup()
   
    &#39; Create a new Part document.
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject, _
                 ThisApplication.FileManager.GetTemplateFile(kPartDocumentObject))
   
    &#39; Set a reference to the compdef.
    Dim oCompDef As PartComponentDefinition
    Set oCompDef = oPartDoc.ComponentDefinition
    &#39; Create a model parameter
    Dim oModelParam As ModelParameter
    Set oModelParam = oCompDef.Parameters.ModelParameters.AddByValue(2, kCentimeterLengthUnits)
   
    &#39; Create a reference parameter
    Dim oReferenceParam As ReferenceParameter
    Set oReferenceParam = oCompDef.Parameters.ReferenceParameters.AddByValue(4, kCentimeterLengthUnits)
   
    &#39; Create a user parameter
    Dim oUserParam As UserParameter
    Set oUserParam = oCompDef.Parameters.UserParameters.AddByValue("length", 6, kCentimeterLengthUnits)
   
    &#39; Create a new custom parameter group
    Dim oCustomParamGroup As CustomParameterGroup
    Set oCustomParamGroup = oCompDef.Parameters.CustomParameterGroups.Add("Custom Group", "CustomGroup1")
   
    &#39; Add the created parameters to this group
    &#39; Note that adding the parameters to the custom group
    &#39; does not remove it from the original group.
    Call oCustomParamGroup.Add(oModelParam)
    Call oCustomParamGroup.Add(oReferenceParam)
    Call oCustomParamGroup.Add(oUserParam)
End Sub
Sub SelectivelyLinkParams()
   
    &#39; Open the source document invisible.
    Dim oSourceDoc As PartDocument
    Set oSourceDoc = ThisApplication.Documents.Open("C:tempblock.ipt", False)
   
    &#39; Set a reference to the component definition.
    Dim oSourceCompDef As PartComponentDefinition
    Set oSourceCompDef = oSourceDoc.ComponentDefinition
   
    Dim oParamsToLink As ObjectCollection
    Set oParamsToLink = ThisApplication.TransientObjects.CreateObjectCollection
   
    &#39; Add parameters named "d0" and "d1".
    &#39; This assumes that the source document contains
    &#39; parameters with these names.
    oParamsToLink.Add oSourceCompDef.Parameters.Item("d0")
    oParamsToLink.Add oSourceCompDef.Parameters.Item("d1")
   
    &#39; Create a new part document, using the default part template.
    Dim oPartDoc As PartDocument
    Set oPartDoc = ThisApplication.Documents.Add(kPartDocumentObject)
   
    &#39; Create a derived parameter table that links only to "d0"
    &#39; and "d1" in the source part.
    &#39; Note: If parameters "d0" and "d1" in the source part
    &#39; are not already exported, they will be automatically
    &#39; exported and hence will result in changing the source part.
    Dim oDerivedParamTable As DerivedParameterTable
    Set oDerivedParamTable = oPartDoc.ComponentDefinition.Parameters. _
        DerivedParameterTables.Add2("C:tempblock.ipt", oParamsToLink)
   
    &#39; Add parameter named "d2"
    &#39; This assumes that the source document
    &#39; contains a parameters named "d2".
    oParamsToLink.Add oSourceCompDef.Parameters.Item("d2")
   
    &#39; Change derived parameter table so it also links to "d2".
    oDerivedParamTable.LinkedParameters = oParamsToLink
End Sub