INVENTOR VBA

大师和广大网友们好，我想创建直齿轮的实体，基于大师inventor R6 VB(A)程序设计319面的T002.IVB,自己依葫芦画瓢写了一点，可是在编译的时候在圆周阵列（如程序中红线部分所示）的时候有问题，小弟愚钝，还请大家能提出自己的宝贵意见。程序如下：
Option Explicit '设置全局私有变量
    Dim Gz, b As Integer
    Dim Gm As Double
Private Sub TextBox4_Change()
    On Error Resume Next
    b = TextBox4.Value
    UserForm1.TextBox3.Text = "已经输入齿宽=" & b
End Sub

Sub UserForm_Initialize() '用户窗体初始化
    '设置齿轮模数原始数据
    Dim GearM As Variant
    GearM = Array(1#, 1.25, 1.5, 2#, 2.5, 3#, 4#, 5#, 6#, 8#, 10#, 12#)
    Dim Mn As Integer
    For Mn = 0 To 11
        UserForm1.ListBox1.AddItem (GearM(Mn))
    Next
    ListBox1.ListIndex = 5: Gm = 3 '模数默认值
    TextBox1.Value = 21: Gz = 21 '齿数默认值
    TextBox3.Text = "默认值：模数=3，齿数=21，齿宽=2..."
End Sub
Function Inv(iangle) As Double 'Inv函数定义
         Inv = Sin(iangle) / Cos(iangle) - iangle
End Function
Function arcCos(ac, ab) As Double 'arcCos函数定义
         Dim aa As Double
         aa = Sqr(ac * ac - ab * ab)
         arcCos = Atn(aa / ab)
End Function

Private Sub CommandButton1_Click()
    Dim opartdoc As PartDocument
    Set opartdoc = ThisApplication.Documents.Add(kPartDocumentObject, ThisApplication.GetTemplateFile(kPartDocumentObject))
   
    '设置对零部件定义的引用
    Dim ocompdef As PartComponentDefinition
    Set ocompdef = opartdoc.ComponentDefinition
   
    '在XY平面上设置草图参考 oSketch .
    Dim oSketch As PlanarSketch
    Set oSketch = ocompdef.Sketches.Add(ocompdef.WorkPlanes(3))
   
    ' 设置临时几何集 oTransGeom.
    Dim otrgm As TransientGeometry
    Set otrgm = ThisApplication.TransientGeometry
     
    ' 齿轮基础参数计算.
    Dim Gylj, Gfr, Gjr, Ggr, Gdr, oaP, oaF, wPF As Double
    Dim Gax, rP, dR, xP, yP, wP, Pi As Double
    Pi = 4 * Atn(1)
    Gylj = 0.34906585 ' 20度的弧度值
    Gm = 0.1 * Gm ' 单位换算到“厘米”
    Gfr = 0.5 * Gz * Gm '分度半径
    Ggr = Gfr - 1.25 * Gm: Gdr = Gfr + Gm '齿根：齿顶圆半径
    Gjr = Gfr * Cos(Gylj) '基圆半径
   

    '画草图圆
    Dim ocircle As SketchCircle
    Dim ocpt As Point2d
    Set ocpt = otrgm.CreatePoint2d(0, 0)
    Set ocircle = oSketch.SketchCircles.AddByCenterRadius(ocpt, Gdr)
   
    '生成轮廓
    Dim oprofile As Profile
    Set oprofile = oSketch.Profiles.AddForSolid
   
    '拉伸成圆柱
    Dim oextrude As ExtrudeFeature
    Set oextrude = ocompdef.Features.ExtrudeFeatures.AddByDistanceExtent(oprofile, b, kPositiveExtentDirection, kJoinOperation)
   
    '得到拉伸特征的顶面作为草图面
    Dim oface As Face
    Set oface = oextrude.StartFaces.Item(1)
    Set oSketch = ocompdef.Sketches.Add(oface)
   

    '拉通单齿部分
    Set oprofile = oSketch.Profiles.AddForSolid
    Dim oextrude1 As ExtrudeFeature
    Set oextrude1 = ocompdef.Features.ExtrudeFeatures.AddByThroughAllExtent(oprofile, kNegativeExtentDirection, kCutOperation)
   
    '为即将生成的阵列特征准备一个对象组合
    Dim ofeatcoll As ObjectCollection
    Set ofeatcoll = ThisApplication.TransientObjects.CreateObjectCollection
    ofeatcoll.Add oextrude1
   
    'On Error Resume Next
    '定义圆形阵列的旋转轴
    Dim oworkaxis As WorkAxis
    Set oworkaxis = ocompdef.WorkAxes.AddByRevolvedFace(oextrude.SideFaces.Item(1), True)
   
    '生成圆形阵列
    Dim ocirpattern As CircularPatternFeature
    Set ocirpattern = ocompdef.Features.CircularPatternFeatures.Add(ofeatcoll, oworkaxis, True, Gz, "360", True)
   
    '调整视图，并且设置为轴测方向
    ThisApplication.ActiveView.Fit True
    Dim ocamera As Camera
    Set ocamera = ThisApplication.ActiveView.Camera
    ocamera.ViewOrientationType = kIsoTopRightViewOrientation
    ocamera.Apply
    Unload Me
End Sub
Private Sub ListBox1_Click()
    Gm = ListBox1.Value
        UserForm1.TextBox3.Text = ""
        UserForm1.TextBox3.Text = "已经选定模数=" & Gm
End Sub

Private Sub TextBox1_Change()
    On Error Resume Next
    Gz = TextBox1.Value
    If Err Then
           UserForm1.TextBox3.Text = "齿数数据必须是整数，请重新输入..."
           Else
           UserForm1.TextBox3.Text = "已经输入齿数=" & Gz
        End If
End Sub
Private Sub CommandButton2_Click()
    Unload Me
End Sub

Option Explicit '设置全局私有变量
    Dim Gz, b As Integer
    Dim Gm As Double
Private Sub TextBox4_Change()
    On Error Resume Next
    b = TextBox4.Value
    UserForm1.TextBox3.Text = "已经输入齿宽=" & b
End Sub

Sub UserForm_Initialize() '用户窗体初始化
    '设置齿轮模数原始数据
    Dim GearM As Variant
    GearM = Array(1#, 1.25, 1.5, 2#, 2.5, 3#, 4#, 5#, 6#, 8#, 10#, 12#)
    Dim Mn As Integer
    For Mn = 0 To 11
        UserForm1.ListBox1.AddItem (GearM(Mn))
    Next
    ListBox1.ListIndex = 5: Gm = 3 '模数默认值
    TextBox1.Value = 21: Gz = 21 '齿数默认值
    TextBox3.Text = "默认值：模数=3，齿数=21，齿宽=2..."
End Sub
Function Inv(iangle) As Double 'Inv函数定义
         Inv = Sin(iangle) / Cos(iangle) - iangle
End Function
Function arcCos(ac, ab) As Double 'arcCos函数定义
         Dim aa As Double
         aa = Sqr(ac * ac - ab * ab)
         arcCos = Atn(aa / ab)
End Function

Private Sub CommandButton1_Click()
    Dim opartdoc As PartDocument
    Set opartdoc = ThisApplication.Documents.Add(kPartDocumentObject, ThisApplication.GetTemplateFile(kPartDocumentObject))
   
    '设置对零部件定义的引用
    Dim ocompdef As PartComponentDefinition
    Set ocompdef = opartdoc.ComponentDefinition
   
    '在XY平面上设置草图参考 oSketch .
    Dim oSketch As PlanarSketch
    Set oSketch = ocompdef.Sketches.Add(ocompdef.WorkPlanes(3))
   
    ' 设置临时几何集 oTransGeom.
    Dim otrgm As TransientGeometry
    Set otrgm = ThisApplication.TransientGeometry
     
    ' 齿轮基础参数计算.
    Dim Gylj, Gfr, Gjr, Ggr, Gdr, oaP, oaF, wPF As Double
    Dim Gax, rP, dR, xP, yP, wP, Pi As Double
    Pi = 4 * Atn(1)
    Gylj = 0.34906585 ' 20度的弧度值
    Gm = 0.1 * Gm ' 单位换算到“厘米”
    Gfr = 0.5 * Gz * Gm '分度半径
    Ggr = Gfr - 1.25 * Gm: Gdr = Gfr + Gm '齿根：齿顶圆半径
    Gjr = Gfr * Cos(Gylj) '基圆半径

还是把完整程序发来吧，上两张就是原程序，基本上都是大师书上的原程序，期待大家的智慧了！

如果不是在Inventor R6中运行，源代码中涉及到“方法”的程序行写法，可能需要细看当前版本VBA的API数据结构，并据此做些改动才行。
这是VBA的特色。

老师您好，我用的版本是2014，请问“当前版本VBA的API数据结构”是在对象浏览器中查看吗？具体如何查看呢？还望老师不吝赐教！拜谢！

楼上你号码？

15527927302，武汉，我是一个大四学生，现在做的毕业设计，望赐教！拜谢！

jsj2010 发表于 2025-3-17 17:07
15527927302，武汉，我是一个大四学生，现在做的毕业设计，望赐教！拜谢！...

毕业设计？
不明白您干吗写程序？Inventor做“实体齿轮”很简单的呀，怎么回事？

老师就是希望我们熟悉一下二次开发的知识，用程序驱动生成零件实体，这可能让大师见笑了。

jsj2010 发表于 2025-3-20 19:18
老师就是希望我们熟悉一下二次开发的知识，用程序驱动生成零件实体，这可能让大师见笑了。 ......

老师的希望并没错。
问题是您应当去编写程序创建Inventor不能创建的模型，而不是Inventor能顺利创建的模型。