Insert Scale Feature Example (VBA)

This example shows how to insert a scale feature.

 

'------------------------------------------

'

' Preconditions: Model document is open.

'

' Postconditiions: Model is scaled by a factor of 3.

'

'-------------------------------------------

Option Explicit

Public Enum swScaleType_e

    swScaleAboutCentroid = 0

    swScaleAboutOrigin = 1

    swScaleAboutCoordinateSystem = 2

End Enum

Public Enum swFeatureError_e

    swFeatureErrorNone = 0                                  '  No error

    swFeatureErrorUnknown = 1                               '  Unknown error

    swFeatureErrorFilletNoLoop = 10                         '  Loop for fillet/chamfer does not exist

    swFeatureErrorFilletNoFace = 11                         '  face for fillet/chamfer does not exist

    swFeatureErrorFilletInvalidRadius = 12                  '  invalid fillet radius or a face blend fillet recommended

    swFeatureErrorFilletNoEdge = 13                         '  Edge for fillet/chamfer does not exist

    swFeatureErrorFilletModelGeometry = 14                  '  Failed to create fillet due to model geometry

    swFeatureErrorFilletRadiusTooSmall = 15                 '  Radius value is too small

    swFeatureErrorFilletCannotExtend = 16                   '  Selected elements cannot be extended to intersect

    swFeatureErrorFilletRadiusEliminateElement = 17         '  Specified radius would eliminate one of the elements

    swFeatureErrorFilletRadiusTooBig = 18                   '  Radius is too big or the elements are tangent or nearly tangent

    swFeatureErrorFilletRadiusTooBig2 = 19                  '  The radius of the fillet is too large to fit the surrounding geometry. Try adjusting the input geometry and radius values or try using a face blend fillet.

    swFeatureErrorExtrusionDisjoint = 30                    '  This feature would create a disjoint body. The direction may be wrong

    swFeatureErrorExtrusionNoEndFound = 31                  '  Cannot locate end of feature

    swFeatureErrorExtrusionBadGeometricConditions = 32      '  Unable to create this extruded feature due to geometric conditions

    swFeatureErrorExtrusionCutContourOpenAndClosed = 33     '  Extruded cuts cannot have both open and closed contours

    swFeatureErrorExtrusionCutContourInvalid = 34           '  Extruded cuts require at least one closed or open contour which does not self-intersect

    swFeatureErrorExtrusionOpenCutContourInvalid = 35       '  Open extruded cuts require a single open contour which does not self-intersect

    swFeatureErrorExtrusionBossContourOpenAndClosed = 36    '  Bosses cannot have both open and closed contours

    swFeatureErrorExtrusionBossContourInvalid = 37          '  Bosses require one or more closed contours which do not self-intersect

End Enum

Sub main()

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swFeatMgr               As SldWorks.FeatureManager

    Dim swScaleFeat             As SldWorks.feature

    Dim swScale                 As SldWorks.ScaleFeatureData

    Dim bRet                    As Boolean

    

    Set swApp = CreateObject("SldWorks.Application")

    Set swModel = swApp.ActiveDoc

    Set swFeatMgr = swModel.FeatureManager

    Set swScaleFeat = swFeatMgr.InsertScale(swScaleAboutOrigin, True, 3, 3, 3)

    

    If swScaleFeat Is Nothing Then Exit Sub

    

    Set swScale = swScaleFeat.GetDefinition

    

    Debug.Print "File = " & swModel.GetPathName

    Debug.Print "  Scale = " & swScaleFeat.Name

    Debug.Print "    Error = " & swScaleFeat.GetErrorCode

End Sub

'------------------------------------------