Hide Table of Contents

Assign Tracking ID Using Macro Feature (VBA)

This example shows how to assign a tracking ID to a face using a macro feature, which then allows the tracking ID to be persistent across SolidWorks sessions, and includes the following modules and class modules:

 

Macros

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

' Preconditions: Model document is open and contains a single part.

'

' Postconditions: Selected face is assigned a tracking ID via a macro feature.

' The macro feature CustomTrackingID1 is created and accessible

' from the FeatureManager design tree.

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

Option Explicit

 

' Handle to macro feature regeneration

Function swmMain(swAppIn, partIn, featureIn)

    Dim featData As SldWorks.MacroFeatureData

    Set featData = featureIn.GetDefinition

    Dim sels, types, selmarks

    Dim faceSel As Object

    Call featData.GetSelections(sels, types, selmarks)

    If IsEmpty(sels) Then

        swmMain = "Face has not been selected!"

        Exit Function

    End If

    Set faceSel = sels(0)

    Dim TrackingID As Long

    Call featData.GetIntegerByName("TrackingID", TrackingID)

    

    If Not faceSel Is Nothing Then

        Dim Cookies As Long

       Cookies = swAppIn.RegisterTrackingDefinition("API_TrackingIDUsingMacroFeature")

        Dim vIDs As Long

        Call faceSel.getTrackingID(Cookies, vIDs)

        Debug.Print vIDs(0)

        faceSel.setTrackingID Cookies, TrackingID

    End If

End Function

 

' Handle to macro feature edit definition

Sub swmPM(swAppIn, partIn, featureIn)

    Dim swPage As New PropMgr

    swPage.Init swAppIn, partIn, featureIn, swCmdEdit, swAppIn.GetCurrentMacroPathName

    swPage.Show

End Sub

 

'Run this procedure to insert macro feature with customized PropertyManager page

Public Sub swmInsertCustomizedMacroFeature()

    Dim swAppIn, partIn, featureIn

    Set swAppIn = Application.SldWorks

    Set partIn = swAppIn.ActiveDoc

    

    Dim swPage As New PropMgr

    swPage.Init swAppIn, partIn, featureIn, swCmdCreate, swAppIn.GetCurrentMacroPathName

    swPage.Show

End Sub

 

PropMgrConst

Public Enum swPageCmdState

    swCmdCreate = 1

    swCmdEdit = 2

End Enum

 

Public Const ID_GROUP = 1

Public Const ID_SELECTION = 2

Public Const ID_NUMBER = 3

 

PropMgr

Option Explicit

 

Private m_swApp As SldWorks.SldWorks

Private m_Part As SldWorks.ModelDoc2

Private m_feature As SldWorks.feature

Private m_Page As SldWorks.PropertyManagerPage2

Private m_Group As SldWorks.PropertyManagerPageGroup

Private m_Selection As SldWorks.PropertyManagerPageSelectionbox

Private m_Number As SldWorks.PropertyManagerPageNumberbox

Private m_swPageCmd As New PropMgrCmd

Private m_cmdState As swPageCmdState

Private m_pageHdlr As New PropMgrHdlr

 

Private Sub Layout()

    Dim swPage As SldWorks.PropertyManagerPage2

    Dim swControl As SldWorks.PropertyManagerPageControl

    Dim title As String

    Dim buttonTypes As Long

    Dim message As String

    Dim ID As Long

    Dim controlType As Integer

    Dim caption As String

    Dim alignment As Integer

    Dim options As Long

    Dim tip As String

    Dim filterArray(0 To 0) As Long

    

    m_pageHdlr.Init Me

    

    If m_cmdState = swCmdCreate Then

        title = "Customized Macro"

    Else

        title = m_feature.Name

    End If

    buttonTypes = swPropertyManagerOptions_OkayButton + swPropertyManagerOptions_CancelButton + swPropertyManagerOptions_LockedPage

    Dim errorh As Long

    Set m_Page = m_swApp.CreatePropertyManagerPage(title, buttonTypes, m_pageHdlr, errorh)

    If Not m_Page Is Nothing Then

        

        'Initial set-up of the dialog

        message = "Customized Macro Feature"

        m_Page.SetMessage message, swImportantMessageBox

        'Add the required controls to the dialog

        'GROUP BOX ------------------------------------------------------------------

        ID = ID_GROUP

        caption = "Face Tracking ID"

        options = swGroupBoxOptions_Visible + swGroupBoxOptions_Expanded '+ swGroupBoxOptions_Checked

        Set m_Group = m_Page.AddGroupBox(ID, caption, options)

        If Not m_Group Is Nothing Then

            'CONTROL Selection box  ------------------------------------------------------------------

            ID = ID_SELECTION

            controlType = swControlType_Selectionbox

            caption = "Sample selection box"

            alignment = swControlAlign_Indent

            options = swControlOptions_Visible + swControlOptions_Enabled

            tip = "Select face"

            Set swControl = m_Group.AddControl(ID, controlType, caption, alignment, options, tip)

            If Not swControl Is Nothing Then

                Set m_Selection = swControl

                filterArray(0) = swSelFACES

                m_Selection.SingleEntityOnly = True

                m_Selection.Height = 50

                m_Selection.SetSelectionFilters (filterArray)

                m_Selection.SetStandardPictureLabel swBitmapLabel_SelectFaceSurface

            End If

            'CONTROL Number box  ------------------------------------------------------------------

            ID = ID_NUMBER

            controlType = swControlType_Numberbox

            caption = "Sample number box"

            alignment = swControlAlign_Indent

            options = swControlOptions_Visible + swControlOptions_Enabled

            tip = "Tracking ID for face"

            Set swControl = m_Group.AddControl(ID, controlType, caption, alignment, options, tip)

            If Not swControl Is Nothing Then

                Set m_Number = swControl

                m_Number.SetRange swNumberBox_UnitlessInteger, 1#, 1000000#, 1, True

                m_Number.Value = m_swPageCmd.getUserTrackingID()

                'm_Number.SetStandardPictureLabel

            End If

        End If

    End If

End Sub

 

Public Sub Show()

    m_Page.Show

End Sub

 

Sub Init(swApp, part, feature, cmdState As swPageCmdState, macroPath As String)

    Set m_swApp = swApp

    Set m_Part = part

    If Not IsEmpty(feature) Then

        Set m_feature = feature

    End If

    m_cmdState = cmdState

    m_Part.ClearSelection

    m_swPageCmd.Init swApp, part, feature, cmdState, macroPath

    Layout

End Sub

 

Public Function GetCmd() As PropMgrCmd

    Set GetCmd = m_swPageCmd

End Function

 

PropMgrCmd

Option Explicit

 

Private m_swApp As SldWorks.SldWorks

Private m_Part As SldWorks.ModelDoc2

Private m_feature As SldWorks.feature

Private m_faceSel As Object

Private m_TrackingID As Long

Private m_featData As SldWorks.MacroFeatureData

Private m_modelComp As SldWorks.Component2

Private m_cmdState As swPageCmdState

Private m_macroPath As String

Public Sub Init(swApp, part, feature, cmdState As swPageCmdState, macroPath As String)

    Set m_swApp = swApp

    Set m_Part = part

    m_macroPath = macroPath

    If Not IsEmpty(feature) Then

        Set m_feature = feature

    End If

    If cmdState = swCmdEdit Then ' On Edit Definition

        Dim ret As Boolean

        Set m_featData = m_feature.GetDefinition

        Set m_modelComp = m_feature.GetComponent

        m_cmdState = cmdState

        ret = m_featData.AccessSelections(m_Part, m_modelComp)

        Dim sels, types, selmarks

        Call m_featData.GetSelections(sels, types, selmarks)

        If Not IsEmpty(sels) Then

            Set m_faceSel = sels(0)

            Call m_faceSel.Select2(True, selmarks(0))

        End If

        Call m_featData.GetIntegerByName("TrackingID", m_TrackingID)

    Else ' On Insert Feature

        m_TrackingID = 2

    End If

End Sub

 

Public Sub OnOk()

    

    If m_cmdState = swCmdEdit Then ' On Edit Definition

        Dim sels, types, selmarks

        Call m_featData.GetSelections(sels, types, selmarks)

        Dim newSels(0 To 0) As Object

        Dim newSelMarks(0 To 0) As Long

        Set newSels(0) = m_faceSel

        newSelMarks(0) = 0

        sels = newSels

        selmarks = newSelMarks

        Call m_featData.SetSelections(sels, selmarks)

        Call m_featData.SetIntegerByName("TrackingID", m_TrackingID)

        Call m_feature.ModifyDefinition(m_featData, m_Part, m_modelComp)

    Else ' On Insert feature

        Dim paramNames, paramTypes, paramValues

        Dim paramNameArray(0 To 0) As String

        Dim paramTypeArray(0 To 0) As Long

        Dim paramValueArray(0 To 0) As String

        paramNameArray(0) = "TrackingID"

        paramTypeArray(0) = swMacroFeatureParamTypeInteger

        paramValueArray(0) = Str(m_TrackingID)

        paramNames = paramNameArray

        paramTypes = paramTypeArray

        paramValues = paramValueArray

        Dim methods(0 To 8) As String

        methods(0) = m_macroPath

        methods(1) = "Macros"

        methods(2) = "swmMain"

        methods(3) = m_macroPath

        methods(4) = "Macros"

        methods(5) = "swmPM"

        methods(6) = ""

        methods(7) = ""

        methods(8) = ""

        Dim feat As Object

        Set feat = m_Part.FeatureManager.InsertMacroFeature3("CustomTrackingID", "", methods, (paramNames), (paramTypes), (paramValues), Nothing, Nothing, Nothing, Nothing, swMacroFeatureByDefault)

    End If

End Sub

 

Public Sub OnCancel()

    If m_cmdState = swCmdEdit Then

        m_featData.ReleaseSelectionAccess

    End If

End Sub

 

Public Sub OnFaceSelect()

    Dim selM

    Set selM = m_Part.SelectionManager

    Set m_faceSel = Nothing

    Set m_faceSel = selM.GetSelectedObject3(1)

End Sub

 

Public Function getUserTrackingID() As Integer

    getUserTrackingID = m_TrackingID

End Function

 

Public Sub setUserTrackingID(TrackingID As Integer)

    m_TrackingID = TrackingID

End Sub

 

PropMgrHdlr

Option Explicit

Implements PropertyManagerPage2Handler

Dim m_pageObj As PropMgr

Public Sub Init(pageObj As PropMgr)

    Set m_pageObj = pageObj

End Sub

 

Private Function PropertyManagerPage2Handler_ConnectToSW(ByVal ThisSW As Object, ByVal Cookie As Long) As Boolean

End Function

 

Private Sub PropertyManagerPage2Handler_OnButtonPress(ByVal ID As Long)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnClose(ByVal reason As Long)

    If reason = swPropertyManagerPageClose_Okay Then

        m_pageObj.GetCmd().OnOk

    ElseIf reason = swPropertyManagerPageClose_Cancel Then

        m_pageObj.GetCmd().OnCancel

    End If

End Sub

 

Private Sub PropertyManagerPage2Handler_OnCheckboxCheck(ByVal ID As Long, ByVal Checked As Boolean)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnComboboxSelectionChanged(ByVal ID As Long, ByVal Item As Long)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnGroupCheck(ByVal ID As Long, ByVal Checked As Boolean)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnGroupExpand(ByVal ID As Long, ByVal Expanded As Boolean)

End Sub

 

Private Function PropertyManagerPage2Handler_OnHelp() As Boolean

End Function

 

Private Sub PropertyManagerPage2Handler_OnListboxSelectionChanged(ByVal ID As Long, ByVal Item As Long)

End Sub

 

Private Sub PropertyManagerPage2Handler_AfterClose()

    Set m_pageObj = Nothing

End Sub

 

Private Sub PropertyManagerPage2Handler_OnNumberboxChanged(ByVal ID As Long, ByVal Value As Double)

    m_pageObj.GetCmd().setUserTrackingID (Value)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnOptionCheck(ByVal ID As Long)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnSelectionboxFocusChanged(ByVal ID As Long)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnTextboxChanged(ByVal ID As Long, ByVal Text As String)

End Sub

 

Private Sub PropertyManagerPage2Handler_OnSelectionBoxListChanged(ByVal ID As Long, ByVal Text As Long)

    m_pageObj.GetCmd().OnFaceSelect

End Sub



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Assign Tracking ID Using Macro Feature (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2012 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.