Create Library Feature Data Object and Library Feature Example (VBA)

See Also

This example shows how to create a library feature data object and a library feature.

 

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

'

' Preconditions: Block.SLDPRT and RectHoleLibFeatDef.SLDLFP exist

'                in the same folder as the macro.

'

' Postconditions: Library feature is added to the part.

'

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

Option Explicit

 

Sub main()

 

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swFeatMgr As SldWorks.FeatureManager

    Dim swLibFeat As SldWorks.LibraryFeatureData

    Dim swModelDocExt As SldWorks.ModelDocExtension

    Dim swFeat As SldWorks.Feature

    Dim longstatus As Long, longwarnings As Long

    Dim boolstatus As Boolean, itr As Integer

    Dim strPartFileName As String, strLibFileName As String

    Dim nRefCount As Long, vConfigNames As Variant

    Dim configName As Variant, refType As Variant, dimName As Variant, dimName2 As Variant

    Dim vRefs As Variant, vRefTypes As Variant

    Dim nLocatingDimCount As Long, nSizeDimCount As Long

    Dim vLocDimName As Variant, vLocDimVal As Variant

    Dim vSizeDimName As Variant, vSizeDimVal As Variant

   

    Set swApp = Application.SldWorks

    strPartFileName = swApp.GetCurrentMacroPathFolder + "\Block.SLDPRT"

    strLibFileName = swApp.GetCurrentMacroPathFolder + "\RectHoleLibFeatDef.SLDLFP"

    

    ' Open a document

    Set swModel = swApp.OpenDoc6(strPartFileName, 1, 0, "", longstatus, longwarnings)

 

    ' Create a library feature definition

    Set swFeatMgr = swModel.FeatureManager

    Set swLibFeat = swFeatMgr.CreateDefinition(swFmLibraryFeature)

    If swLibFeat Is Nothing Then

        Debug.Print "ERROR: Creation of library feature data object failed."

        Exit Sub

    End If

    

    ' Initialize the library feature definition

    boolstatus = swLibFeat.Initialize(strLibFileName)

    

    ' Get all of the configurations

    vConfigNames = swLibFeat.GetAllConfigurationNames

    If Not IsEmpty(vConfigNames) Then

        Debug.Print "Configurations in library part: "

        For Each configName In vConfigNames

            Debug.Print vbTab + configName

        Next

    End If

    

    ' Set a particular configuration...this action is required

    ' Otherwise, last active configuration is used

    ' This also re-initializes the library feature data object

    swLibFeat.ConfigurationName = vConfigNames(1)

    

    ' Get the type of references required

    nRefCount = swLibFeat.GetReferencesCount

    vRefs = swLibFeat.GetReferences(vRefTypes)

    If Not IsEmpty(vRefTypes) Then

        Debug.Print "Types of references required: "

        For Each refType In vRefTypes

            Debug.Print vbTab + CStr(refType)

        Next

    End If

    

    ' Get the locating dimension names and values

    nLocatingDimCount = swLibFeat.GetDimensionsCount(swLibFeatLocatingDimension)

    vLocDimVal = swLibFeat.GetDimensions(swLibFeatLocatingDimension, vLocDimName)

    If Not IsEmpty(vLocDimName) Then

        Debug.Print "Locating dimension names and values: "

        itr = 0

        For Each dimName In vLocDimName

            Debug.Print vbTab + CStr(dimName) + ": " + CStr(vLocDimVal(itr))

            itr = itr + itr

        Next

    End If

    

    ' Get the size dimension names and values

    nSizeDimCount = swLibFeat.GetDimensionsCount(swLibFeatSizeDimension)

    vSizeDimVal = swLibFeat.GetDimensions(swLibFeatSizeDimension, vSizeDimName)

    If Not IsEmpty(vSizeDimName) Then

        Debug.Print "Size dimension names and values: "

        itr = 0

        For Each dimName2 In vSizeDimName

            Debug.Print vbTab + CStr(dimName2) + ": " + CStr(vSizeDimVal(itr))

            itr = itr + itr

        Next

    End If

    

    ' Do the selections

    swModel.ClearSelection2 True

    Set swModelDocExt = swModel.Extension

    boolstatus = swModelDocExt.SelectByID2("", "EDGE", -2.480159344032E-05, 0.01001926368383, -0.009622457539251, True, 2, Nothing, 0)

    boolstatus = swModelDocExt.SelectByID2("", "EDGE", -0.05517142328046, 0.0100907515656, -6.165527435087E-05, True, 1, Nothing, 0)

    boolstatus = swModelDocExt.SelectByID2("", "FACE", -0.03816456581205, 0.009999999999934, -0.01684134212712, True, 0, Nothing, 0)

    

    ' Create a library feature

    Set swFeat = swFeatMgr.CreateFeature(swLibFeat)

    

    If swLibFeat Is Nothing Then

        Debug.Print " ERROR: Creation of the library feature failed."

    Else

        Debug.Print "Name of the library feature added : " & swFeat.Name

    End If

            

    swModel.ClearSelection2 True

    

End Sub