Autodesk Inventor VBA脚本

Question

我试图使用VBA脚本在Autodesk Inventor中连接两个实体模型配置文件。我尽可能绘制出应该稍后用作配置文件的3D线条。脚本完成绘图后，我可以选择两个循环，并通过GUI使用放样操作进行连接。我认为这应该是可能的脚本，我也无法弄清楚如何。这里是我的脚本至今：

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 

Answer 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