Sub CreateBody() Dim swModeler As SldWorks.Modeler Set swModeler = swApp.GetModeler Dim dblData(8) As Double dblData(0) = 0 dblData(1) = 0 dblData(2) = 0 dblData(3) = 0 dblData(4) = 0 dblData(5) = 1 dblData(6) = 0.05 dblData(7) = 0.01 Set swBody = swModeler.CreateBodyFromCyl(dblData) End Sub Public swApp As SldWorks.SldWorks Public swModel As SldWorks.ModelDoc2 Public swBody As SldWorks.Body2 Public swMacroFeatData As SldWorks.MacroFeatureData Set swApp = app Set swMacroFeatData = feat.GetDefinition Call CreateBody 'Assign edge and face IDs Dim vEdges As Variant Dim vFaces As Variant vEdges = swBody.GetEdges vFaces = swBody.GetFaces Dim i As Integer For i = 0 To UBound(vEdges) swMacroFeatData.SetEdgeUserId vEdges(i), i, 0 Next i For i = 0 To UBound(vFaces) swMacroFeatData.SetFaceUserId vFaces(i), i, 0 Next i Set swmRebuild = swBody 'Get EditBodies - replace all bodies Dim swPart As SldWorks.PartDoc Dim vEditBodies As Variant Set swPart = swModel vEditBodies = swPart.GetBodies2(swSolidBody, False) 'Create the macro feature swModel.FeatureManager.InsertMacroFeature3 "Cylinder", Empty, strMacroMethods, _ Nothing, Nothing, Nothing, Nothing, Nothing, vEditBodies, Nothing, 0 Option Explicit Public swApp As SldWorks.SldWorks Public swModel As SldWorks.ModelDoc2 Public swFeat As SldWorks.feature Public swMacroFeatData As SldWorks.MacroFeatureData Public swBody As SldWorks.Body2 Public swEditBody(0) As SldWorks.Body2 Public vEditBody As Variant Public pm As PropMgr Sub main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swFeat = Nothing Set pm = New PropMgr pm.Layout End Sub Option Explicit Private pmPage As PropertyManagerPage2 Private pmGroup As PropertyManagerPageGroup Private pmSelBox As PropertyManagerPageSelectionbox Private pmHandler As New PropMgrHdlr Sub Layout() Set pmHandler = New PropMgrHdlr 'Create PMP Set pmPage = swApp.CreatePropertyManagerPage("Cylinder", _ swPropertyManagerOptions_OkayButton + swPropertyManagerOptions_CancelButton, _ pmHandler, Empty) 'Message pmPage.SetMessage "Select body to modify.", swImportantMessageBox 'Group box Set pmGroup = pmPage.AddGroupBox(0, "Input body", _ swGroupBoxOptions_Visible + swGroupBoxOptions_Expanded) 'Selection box Set pmSelBox = pmGroup.AddControl(1, swControlType_Selectionbox, Empty, _ swControlAlign_Indent, swControlOptions_Visible + swControlOptions_Enabled, _ "Select body") Dim filterArray(0 To 1) As Long filterArray(0) = swSelSOLIDBODIES filterArray(1) = swSelSURFACEBODIES pmSelBox.SetSelectionFilters filterArray pmSelBox.SingleEntityOnly = True pmSelBox.Height = 12 pmSelBox.SetStandardPictureLabel swBitmapLabel_SelectFace 'Show pmPage.Show2 0 End Sub Option Explicit Implements PropertyManagerPage2Handler9 Private Sub PropertyManagerPage2Handler9_AfterActivation() End Sub Private Sub PropertyManagerPage2Handler9_AfterClose() End Sub Private Function PropertyManagerPage2Handler9_OnActiveXControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long End Function Private Sub PropertyManagerPage2Handler9_OnButtonPress(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnCheckboxCheck(ByVal Id As Long, ByVal Checked As Boolean) End Sub Private Sub PropertyManagerPage2Handler9_OnClose(ByVal Reason As Long) If Reason = swPropertyManagerPageClose_Okay Then Call InsertMacroFeature End Sub Private Sub PropertyManagerPage2Handler9_OnComboboxEditChanged(ByVal Id As Long, ByVal Text As String) End Sub Private Sub PropertyManagerPage2Handler9_OnComboboxSelectionChanged(ByVal Id As Long, ByVal Item As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnGainedFocus(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnGroupCheck(ByVal Id As Long, ByVal Checked As Boolean) End Sub Private Sub PropertyManagerPage2Handler9_OnGroupExpand(ByVal Id As Long, ByVal Expanded As Boolean) End Sub Private Function PropertyManagerPage2Handler9_OnHelp() As Boolean End Function Private Function PropertyManagerPage2Handler9_OnKeystroke(ByVal Wparam As Long, ByVal Message As Long, ByVal Lparam As Long, ByVal Id As Long) As Boolean End Function Private Sub PropertyManagerPage2Handler9_OnListboxRMBUp(ByVal Id As Long, ByVal PosX As Long, ByVal PosY As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnListboxSelectionChanged(ByVal Id As Long, ByVal Item As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnLostFocus(ByVal Id As Long) End Sub Private Function PropertyManagerPage2Handler9_OnNextPage() As Boolean End Function Private Sub PropertyManagerPage2Handler9_OnNumberboxChanged(ByVal Id As Long, ByVal Value As Double) End Sub Private Sub PropertyManagerPage2Handler9_OnNumberBoxTrackingCompleted(ByVal Id As Long, ByVal Value As Double) End Sub Private Sub PropertyManagerPage2Handler9_OnOptionCheck(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnPopupMenuItem(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnPopupMenuItemUpdate(ByVal Id As Long, retval As Long) End Sub Private Function PropertyManagerPage2Handler9_OnPreview() As Boolean End Function Private Function PropertyManagerPage2Handler9_OnPreviousPage() As Boolean End Function Private Sub PropertyManagerPage2Handler9_OnRedo() End Sub Private Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutCreated(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnSelectionboxCalloutDestroyed(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnSelectionboxFocusChanged(ByVal Id As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnSelectionboxListChanged(ByVal Id As Long, ByVal Count As Long) End Sub Private Sub PropertyManagerPage2Handler9_OnSliderPositionChanged(ByVal Id As Long, ByVal Value As Double) End Sub Private Sub PropertyManagerPage2Handler9_OnSliderTrackingCompleted(ByVal Id As Long, ByVal Value As Double) End Sub Private Function PropertyManagerPage2Handler9_OnSubmitSelection(ByVal Id As Long, ByVal Selection As Object, ByVal SelType As Long, ItemText As String) As Boolean 'Accept selection PropertyManagerPage2Handler9_OnSubmitSelection = True 'Get EditBodies for use in IFeatureManager::InsertMacroFeature3 Set swEditBody(0) = Selection vEditBody = swEditBody End Function Private Function PropertyManagerPage2Handler9_OnTabClicked(ByVal Id As Long) As Boolean End Function Private Sub PropertyManagerPage2Handler9_OnTextboxChanged(ByVal Id As Long, ByVal Text As String) End Sub Private Sub PropertyManagerPage2Handler9_OnUndo() End Sub Private Sub PropertyManagerPage2Handler9_OnWhatsNew() End Sub Private Function PropertyManagerPage2Handler9_OnWindowFromHandleControlCreated(ByVal Id As Long, ByVal Status As Boolean) As Long End Function 'Group box Set pmGroup2 = pmPage.AddGroupBox(2, "Depth", swGroupBoxOptions_Expanded + _ swGroupBoxOptions_Visible) 'Number box Set pmNumBoxExtrude = pmGroup2.AddControl(3, swControlType_Numberbox, Empty, _ swControlAlign_LeftEdge, swControlOptions_Visible + swControlOptions_Enabled, _ "Depth") pmNumBoxExtrude.SetRange2 swNumberBox_Length, 0, 1, True, 0.005, 0.005, 0.005 dblDepth = 0.005 'initial value pmNumBoxExtrude.Value = dblDepth Option Explicit Private pmPage As PropertyManagerPage2 Private pmGroup As PropertyManagerPageGroup Private pmGroup2 As PropertyManagerPageGroup Private pmSelBox As PropertyManagerPageSelectionbox Private pmNumBoxExtrude As PropertyManagerPageNumberbox Private pmHandler As New PropMgrHdlr If Id = 3 Then dblDepth = Value Public Const INSERT As Integer = 2 Public Const EDIT As Integer = 1 Public STATE As Integer STATE = EDIT Set swApp = app Set swFeat = feat Set swModel = model Set swMacroFeatData = swFeat.GetDefinition swMacroFeatData.AccessSelections swModel, Nothing vEditBody = swMacroFeatData.EditBodies Set swBody = vEditBody(0) swBody.Select2 False, Nothing Set pm = New PropMgr pm.Layout If STATE = EDIT Then swMacroFeatData.EditBodies = vEditBody If Reason = swPropertyManagerPageClose_Okay Then If STATE = INSERT Then Call InsertMacroFeature ElseIf STATE = EDIT Then swFeat.ModifyDefinition swMacroFeatData, swModel, Nothing End If Else If Not swMacroFeatData Is Nothing Then swMacroFeatData.ReleaseSelectionAccess Set swBody = Nothing STATE = 0 End If swModel.ClearSelection2 True 'Parameters (used to remember PMP control values during edit definition) Dim strParamNames(0) As String Dim lngParamTypes(0) As Long Dim strParamValues(0) As String strParamNames(0) = "depth" lngParamTypes(0) = 1 strParamValues(0) = Str(dblDepth) 'Create the macro feature swModel.FeatureManager.InsertMacroFeature3 "MacroFeature", Empty, strMacroMethods, _ strParamNames, lngParamTypes, strParamValues, Nothing, Nothing, vEditBody, Nothing, 0 'store current depth value in macro feature swMacroFeatData.SetDoubleByName "depth", dblDepth swMacroFeatData.GetDoubleByName "depth", dblDepth 'get current depth value If STATE = 0 Then swMacroFeatData.GetDoubleByName "depth", dblDepth If STATE = INSERT Then dblDepth = 0.005 'initial value If STATE <> 0 Then swBody.Display3 swModel, 255, 0 Call CreateBody swModel.ViewZoomtofit2 'Preview Call CreateBody