I'm trying to write a VBA script to generate a series of swept curves and assign a specific color to each. The simplified code is:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Part.InsertCurveFileBegin
boolstatus = Part.InsertCurveFilePoint(0.48, 0.45, 0.854)
boolstatus = Part.InsertCurveFilePoint(0.521958626392236, 0.445255487581279, 0.855138131944955)
boolstatus = Part.InsertCurveFilePoint(0.564924504317148, 0.440431310679495, 0.857766776035967)
boolstatus = Part.InsertCurveFilePoint(0.609904885307415, 0.435447804811584, 0.863376444419092)
boolstatus = Part.InsertCurveFilePoint(0.657907020895713, 0.430225305494481, 0.873457649240387)
boolstatus = Part.InsertCurveFilePoint(0.70952727730516, 0.42425344385608, 0.888720497131432)
boolstatus = Part.InsertCurveFileEnd()
boolstatus = Part.Extension.SelectByID2("Curve1", "REFERENCECURVES", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("Curve1", "REFERENCECURVES", 0, 0, 0, False, 4, Nothing, 0)
Dim swFeat As Object
Dim swFeatMgr As Object
Set swFeatMgr = Part.FeatureManager
Dim swFeatData As Object
Set swFeatData = swFeatMgr.CreateDefinition(swFeatureNameID_e.swFmSweep)
swFeatData.AdvancedSmoothing = False
swFeatData.AlignWithEndFaces = 0
swFeatData.AutoSelect = True
swFeatData.CircularProfile = True
swFeatData.CircularProfileDiameter = 0.012
swFeatData.D1ReverseTwistDir = False
swFeatData.EndTangencyType = 0
swFeatData.FeatureScope = True
swFeatData.MaintainTangency = False
swFeatData.Merge = True
swFeatData.MergeSmoothFaces = True
swFeatData.PathAlignmentType = 10
swFeatData.StartTangencyType = 0
swFeatData.ThinFeature = False
swFeatData.ThinWallType = 0
swFeatData.TwistControlType = 0
swFeatData.SetTwistAngle 0
swFeatData.SetWallThickness True, 0
Set swFeat = swFeatMgr.CreateFeature(swFeatData)
Dim dMatPrps(8) As Double
dMatPrps(0) = 200# / 255
dMatPrps(1) = 0# / 255
dMatPrps(2) = 0# / 255
dMatPrps(3) = 1
dMatPrps(4) = 1
dMatPrps(5) = 0.5
dMatPrps(6) = 0.3125
dMatPrps(7) = 0
dMatPrps(8) = 0
'Set swFeat = Part.Extension.GetLastFeatureAdded()
swFeat.SetMaterialPropertyValues2 dMatPrps, swInConfigurationOpts_e.swThisConfiguration, Empty
Part.ClearSelection2 True
End Sub
The script fails on the call to swFeat.SetMaterialPropertyValues2
with error message "Run-time error '-2147417848 (80010108)': Automation error. The object invoked has disconnected from its clients."
The error persists if I uncomment the preceding call to Part.Extension.GetLastFeatureAdded()
.
Curiously, the call to swFeat.GetMaterialPropertyValues2 swInConfigurationOpts_e.swThisConfiguration, Empty
does not fail, but returns an 8-element double array containing all -1 values. The -1's (which are invalid values) suggests the problem may be that no material is assigned to/initialized in the newly-created feature, but nothing in the Feature class API stands out as an "add material" method.
Any help in diagnosing the error would be much appreciated.