Autodesk Inventor VBA 脚本

Posted 2023-03-16

【中文标题】Autodesk Inventor VBA 脚本

【英文标题】：Autodesk Inventor VBA Scripting

【发布时间】：2014-11-06 23:29:28

【问题描述】：

我正在尝试使用 VBA 脚本连接 Autodesk Inventor 中的两个实体模型配置文件。我已经绘制了 3D 线条，这些线条应该在以后充当轮廓。脚本完成绘制后，我可以选择两个循环并通过 GUI 使用 loft 操作将它们连接起来。我认为这也应该可以从脚本中获得，我只是无法弄清楚如何。到目前为止，这是我的脚本：

Sub loft()

  Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject, , True)
  Set oPartDef = oDoc.ComponentDefinition

  Dim osketch3D As Sketch3D
  Set osketch3D = oPartDef.Sketches3D.Add()

  Set oTG = ThisApplication.TransientGeometry
  Dim wire(198) As SketchLine3D

  Set wire(0) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 0, 0), oTG.CreatePoint(10, 0, 0))
  Set wire(1) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 0, 0), oTG.CreatePoint(10, 10, 1))
  Set wire(2) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 10, 1), oTG.CreatePoint(0, 10, 0))
  Set wire(3) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 10, 0), oTG.CreatePoint(0, 0, 0))

  Set wire(4) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 0, 5), oTG.CreatePoint(10, 0, 5))
  Set wire(5) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 0, 5), oTG.CreatePoint(10, 10, 5))
  Set wire(6) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 10, 5), oTG.CreatePoint(0, 10, 5))
  Set wire(7) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 10, 5), oTG.CreatePoint(0, 0, 5))

' .....    
' Select wires 0-3 and 4-7 as profiles, put them in an object collection and call the loft op.

End Sub

【参考方案1】：

Sub loft()

    'Declare PartDocument to activate Intellisense
    Dim oDoc As PartDocument

    Set oDoc = ThisApplication.Documents.Add(kPartDocumentObject, , True)
    Set oPartDef = oDoc.ComponentDefinition

    Dim osketch3D As Sketch3D
    Set osketch3D = oPartDef.Sketches3D.Add()

    Set oTG = ThisApplication.TransientGeometry
    Dim wire(198) As SketchLine3D

    Set wire(0) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 0, 0), oTG.CreatePoint(10, 0, 0))
    Set wire(1) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 0, 0), oTG.CreatePoint(10, 10, 1))
    Set wire(2) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 10, 1), oTG.CreatePoint(0, 10, 0))
    Set wire(3) = osketch3D.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 10, 0), oTG.CreatePoint(0, 0, 0))

    'Declare Profile3D to regroup wires.
    Dim oProfile1 As Profile3D
    Set oProfile1 = osketch3D.Profiles3D.AddOpen

    'Declare another sketch to be able to catch 2 differents profiles.
    Dim osketch3D2 As Sketch3D
    Set osketch3D2 = oPartDef.Sketches3D.Add()

    Set wire(4) = osketch3D2.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 0, 5), oTG.CreatePoint(10, 0, 5))
    Set wire(5) = osketch3D2.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 0, 5), oTG.CreatePoint(10, 10, 5))
    Set wire(6) = osketch3D2.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(10, 10, 5), oTG.CreatePoint(0, 10, 5))
    Set wire(7) = osketch3D2.SketchLines3D().AddByTwoPoints(oTG.CreatePoint(0, 10, 5), oTG.CreatePoint(0, 0, 5))

    'Declare second Profile3D to regroup wires.
    Dim oProfile2 As Profile3D
    Set oProfile2 = osketch3D2.Profiles3D.AddOpen

    'Create object collection need by Inventor functions.
    Dim oCollection As ObjectCollection
    Set oCollection = ThisApplication.TransientObjects.CreateObjectCollection

    'Add profiles to collection.
    oCollection.Add oProfile1
    oCollection.Add oProfile2

    'Create loft definition needed by Loft function.
    Dim oLoftDef As LoftDefinition
    Set oLoftDef = oDoc.ComponentDefinition.Features.LoftFeatures.CreateLoftDefinition(oCollection, kSurfaceOperation)

    'Creating loft.
    Dim oLoftFeat As LoftFeature
    Set oLoftFeat = oDoc.ComponentDefinition.Features.LoftFeatures.Add(oLoftDef)



End Sub

【讨论】：

您应该注释代码中被更改的部分，并说明它解决问题的原因。

我想它可以澄清一些事情，但这个解决方案非常简单，所以我不相信有 cmets 的地方。既然你指出了，我现在将修改我的答案。