SolidWorks VBA 中循环中的某些拉伸不起作用

解决 SolidWorks VBA 中循环中的某些拉伸不起作用

vba
Sub LoopExtrude()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swPart As SldWorks.PartDoc
    Dim swFeatMgr As SldWorks.FeatureManager
    Dim swFeat As SldWorks.Feature
    Dim swExtrude As SldWorks.Feature
    
    ' 创建 SolidWorks 应用程序对象
    Set swApp = CreateObject("SldWorks.Application")
    swApp.Visible = True
    
    ' 打开一个零件文件
    Set swModel = swApp.OpenDoc2("C:\Path\to\part.sldprt", swDocPART)
    Set swPart = swModel
    
    ' 获取特征管理器
    Set swFeatMgr = swPart.FeatureManager
    
    ' 循环创建拉伸特征
    For i = 1 To 10
        ' 创建一个基础特征
        Set swFeat = swFeatMgr.InsertFeatureEx(swFeatureNameID_e.swExtrudeFeature, 0, 0, 0, 0, 0, 0)
        
        ' 设置拉伸参数
        Set swExtrude = swFeat.GetDefinition
        swExtrude.SetExtrudeType swBlind, swBoth
        swExtrude.SetBlindExtent swBlind, 1.0
        
        ' 执行拉伸操作
        swFeat.ModifyDefinition swExtrude, swModel, Nothing
        
        ' 更新零件
        swModel.EditRebuild3
    Next i
    
    ' 保存零件
    swModel.SaveAs2 "C:\Path\to\output.sldprt", swSaveAsCurrentVersion, False, False
End Sub