2014-09-12 99 views
2

我試圖使用VBA腳本在Autodesk Inventor中連接兩個實體模型配置文件。我儘可能繪製出應該稍後用作配置文件的3D線條。腳本完成繪圖後,我可以選擇兩個循環,並通過GUI使用放樣操作進行連接。我認爲這應該是可能的腳本,我也無法弄清楚如何。這裏是我的腳本至今:Autodesk Inventor VBA腳本

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 
+0

你應該評論說是改變了代碼的部件和提爲什麼它解決了這個問題。 – 2015-08-26 16:32:23

+1

我想它可以澄清事情,但這個解決方案非常簡單,所以我不相信有評論的地方。 既然你指出了,我現在將修改我的答案。 – 2015-08-26 17:09:36