I'm trying to make a super-automated set of sheet metal custom properties. Basically, I want to get the bounding box length, width, area, and overall tool path length from the cut list properties and into the global properties so they can get nice fields on a drawing. I've had pretty good luck so far cribbing from code I've found online, but I've hit a stumbling block.

The macro I've come up with works perfectly well when I run it on an existing part, but when I apply it to the part template, and then build a new part based on that template, it does nothing.

This is the code I'm working with.  Anyone have any idea what I'm doing wrong? Thanks!

<br><br>Option Explicit<br><br>Const EMBED_MACRO_FEATURE As Boolean = True<br>Const BASE_NAME As String = "SheetMetalProperties"<br><br>Dim HandledModels As Collection<br><br><br>Sub main()<br><br>    Dim swApp As SldWorks.SldWorks<br>    Set swApp = Application.SldWorks<br>    <br>    Dim swModel As SldWorks.ModelDoc2<br>    <br>    Set swModel = swApp.ActiveDoc<br>    <br>    If Not swModel Is Nothing Then<br>        If swModel.GetType() = swDocumentTypes_e.swDocPART Then<br>            <br>            <br>            <br>            Dim curMacroPath As String<br>            curMacroPath = swApp.GetCurrentMacroPathName<br>            <br>            Dim vMethods(8) As String<br>            Dim moduleName As String<br>            <br>            GetMacroEntryPoint swApp, curMacroPath, moduleName, ""<br>            <br>            vMethods(0) = curMacroPath: vMethods(1) = moduleName: vMethods(2) = "swmRebuild"<br>            vMethods(3) = curMacroPath: vMethods(4) = moduleName: vMethods(5) = "swmEditDefinition"<br>            vMethods(6) = curMacroPath: vMethods(7) = moduleName: vMethods(8) = "swmSecurity"<br>            <br>            Dim opts As swMacroFeatureOptions_e<br>            <br>            If EMBED_MACRO_FEATURE Then<br>                opts = swMacroFeatureOptions_e.swMacroFeatureEmbedMacroFile<br>            Else<br>                opts = swMacroFeatureOptions_e.swMacroFeatureByDefault<br>            End If<br>            <br>            Dim swFeat As SldWorks.Feature<br>            Set swFeat = swModel.FeatureManager.InsertMacroFeature3(BASE_NAME, "", vMethods, _<br>                Empty, Empty, Empty, Empty, Empty, Empty, _<br>                Empty, opts)<br>            <br>            If swFeat Is Nothing Then<br>                MsgBox "Failed to create model load watcher"<br>            End If<br>        Else<br>            MsgBox "This macro is only for Piece Parts"<br>        End If<br>    Else<br>        MsgBox "Please open model"<br>    End If<br>    <br>End Sub<br><br>Sub GetMacroEntryPoint(app As SldWorks.SldWorks, macroPath As String, ByRef moduleName As String, ByRef procName As String)<br>        <br>    Dim vMethods As Variant<br>    vMethods = app.GetMacroMethods(macroPath, swMacroMethods_e.swMethodsWithoutArguments)<br>    <br>    Dim i As Integer<br>    <br>    If Not IsEmpty(vMethods) Then<br>    <br>        For i = 0 To UBound(vMethods)<br>            Dim vData As Variant<br>            vData = Split(vMethods(i), ".")<br>            <br>            If i = 0 Or LCase(vData(1)) = "main" Then<br>                moduleName = vData(0)<br>                procName = vData(1)<br>            End If<br>        Next<br>        <br>    End If<br>    <br>End Sub<br><br>Function swmRebuild(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant<br>    Dim swFeat As SldWorks.Feature<br>    Set swFeat = varFeat<br>    <br>    Dim swModel As SldWorks.ModelDoc2<br>    Set swModel = varDoc<br>    <br>    If Not swModel Is Nothing Then<br>        Dim swCutListFeat As SldWorks.Feature, swSMBaseFlangeFeat As SldWorks.Feature<br>        Dim mainProps As SldWorks.CustomPropertyManager<br><br>        Set mainProps = swModel.Extension.CustomPropertyManager("")<br>        <br>        Set swCutListFeat = GetNextCutList(swModel, swModel.FirstFeature)<br>        Do While Not swCutListFeat Is Nothing<br>            Dim val As String, resolvedVal As String<br>            Dim WasResolved As Boolean, LinkToProperty As Boolean<br>            Dim result As Integer<br>            Dim outerCut As Double, innerCut As Double, Length As Double, Width As Double, Area As Double<br>            Dim cutProps As SldWorks.CustomPropertyManager<br>                        <br>            Set cutProps = swCutListFeat.CustomPropertyManager<br>            <br>            result = cutProps.Get6("Bounding Box Length", False, val, resolvedVal, WasResolved, LinkToProperty)<br>            If IsNumeric(resolvedVal) Then<br>                Length = CDbl(resolvedVal)<br>                result = mainProps.Add3("LENGTH", swCustomInfoText, "x " + DecimalToInches(Length, 16), swCustomPropertyDeleteAndAdd)<br>            End If<br>            <br>            result = cutProps.Get6("Bounding Box Width", False, val, resolvedVal, WasResolved, LinkToProperty)<br>            If IsNumeric(resolvedVal) Then<br>                Width = CDbl(resolvedVal)<br>                result = mainProps.Add3("WIDTH", swCustomInfoText, "x " + DecimalToInches(Width, 16), swCustomPropertyDeleteAndAdd)<br>            End If<br>            <br>            result = cutProps.Get6("Bounding Box Area", False, val, resolvedVal, WasResolved, LinkToProperty)<br>            If IsNumeric(resolvedVal) Then<br>                Area = CDbl(resolvedVal) / 144<br>                result = mainProps.Add3("SURFACE AREA AUTO", swCustomInfoText, CStr(Format(Area, "0.000")), swCustomPropertyDeleteAndAdd)<br>            End If<br>            <br>            result = cutProps.Get6("Cutting Length-Outer", False, val, resolvedVal, WasResolved, LinkToProperty)<br>            If result <> swCustomInfoGetResult_NotPresent And IsNumeric(resolvedVal) Then<br>                outerCut = CDbl(resolvedVal)<br>                result = cutProps.Get6("Cutting Length-Inner", False, val, resolvedVal, WasResolved, LinkToProperty)<br>                If result <> swCustomInfoGetResult_NotPresent And IsNumeric(resolvedVal) Then<br>                    innerCut = CDbl(resolvedVal)<br>                    result = mainProps.Add3("BURN PATH LENGTH", swCustomInfoText, Format(CStr(outerCut + innerCut), "0.000"), swCustomPropertyDeleteAndAdd)<br>                End If<br>            End If<br>            <br>            Set swCutListFeat = GetNextCutList(swModel, swCutListFeat.GetNextFeature)<br>        Loop<br>   End If     <br><br>End Function<br><br>Function swmEditDefinition(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant<br>    swmEditDefinition = True<br>End Function<br><br>Function swmSecurity(varApp As Variant, varDoc As Variant, varFeat As Variant) As Variant<br><br>    Dim swFeat As SldWorks.Feature<br>    Set swFeat = varFeat<br>    <br>    If HandledModels Is Nothing Then<br>        Set HandledModels = New Collection<br>    End If<br><br>    Dim swModel As SldWorks.ModelDoc2<br>    Set swModel = varDoc<br>        <br>    If Not CollectionContains(HandledModels, swModel) Then<br>        <br>        HandledModels.Add swModel<br>        Dim swApp As SldWorks.SldWorks<br>        Set swApp = varApp<br>        ClearCache swApp<br>        <br>        OnModelLoad swModel<br>        <br>    End If<br><br>    swmSecurity = SwConst.swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault<br><br>End Function<br><br>Sub ClearCache(app As SldWorks.SldWorks)<br>    <br>    If Not HandledModels Is Nothing Then<br>    <br>        Dim vDocs As Variant<br>        vDocs = app.GetDocuments<br>        <br>        If Not IsEmpty(vDocs) Then<br>            <br>            Dim i As Integer<br>            <br>            For i = HandledModels.Count To 1 Step -1<br>            <br>                Dim swModel As SldWorks.ModelDoc2<br>                Set swModel = HandledModels(i)<br>                <br>                If Not ArrayContains(vDocs, swModel) Then<br>                    HandledModels.Remove i<br>                End If<br>                <br>            Next<br>            <br>        End If<br>        <br>    End If<br>    <br>End Sub<br><br>Function CollectionContains(coll As Collection, model As SldWorks.ModelDoc2) As Boolean<br><br>    Dim i As Integer<br><br>    For i = 1 To coll.Count()<br>        If coll(i) Is model Then<br>            CollectionContains = True<br>            Exit Function<br>        End If<br>    Next<br><br>    CollectionContains = False<br><br>End Function<br><br>Function ArrayContains(arr As Variant, model As SldWorks.ModelDoc2) As Boolean<br><br>    Dim i As Integer<br><br>    If Not IsEmpty(arr) Then<br>        For i = 0 To UBound(arr)<br>            Dim thisModel As SldWorks.ModelDoc2<br>            Set thisModel = arr(i)<br>            If thisModel Is model Then<br>                ArrayContains = True<br>                Exit Function<br>            End If<br>        Next<br>    End If<br>    <br>    ArrayContains = False<br><br>End Function<br><br>Sub OnModelLoad(model As SldWorks.ModelDoc2)<br>    Dim cpm As CustomPropertyManager<br>    Dim exists As swCustomInfoGetResult_e<br>    Dim results As swCustomInfoAddResult_e<br>    Dim WasResolved As Boolean, LinkToProperty As Boolean<br>    Dim val As String, valout As String<br>        <br>    Set cpm = model.Extension.CustomPropertyManager("")<br>    exists = cpm.Get6("DESIGN BY", False, val, valout, WasResolved, LinkToProperty)<br>    <br>    If exists = swCustomInfoGetResult_NotPresent Then<br>        results = cpm.Add3("DESIGN BY", swCustomInfoText, UCase(Environ("USERNAME")), swCustomPropertyOnlyIfNew)<br>    End If<br>    <br>    exists = cpm.Get6("DESIGN DATE", False, val, valout, WasResolved, LinkToProperty)<br>    <br>    If exists = swCustomInfoGetResult_NotPresent Then<br>        results = cpm.Add3("DESIGN DATE", swCustomInfoText, CStr(Format(Date, "mm/dd/yyyy")), swCustomPropertyOnlyIfNew)<br>    End If<br>    <br>End Sub<br><br><br>Function GetNextCutList(model As SldWorks.ModelDoc2, swFeat As SldWorks.Feature) As SldWorks.Feature<br>    <br>    On Error Resume Next<br>    <br>    Dim swApp As SldWorks.SldWorks<br>    Dim swBodyFolder        As SldWorks.BodyFolder<br>    Set swApp = Application.SldWorks<br>    <br><br>    If swFeat Is Nothing Then Set swFeat = model.FirstFeature<br>    <br>    Do While Not swFeat Is Nothing<br>        <br>            If swFeat.GetTypeName = "SolidBodyFolder" Or swFeat.GetTypeName = "CutListFolder" Or swFeat.GetTypeName = "SubWeldFolder" Then<br>                Set swBodyFolder = swFeat.GetSpecificFeature2<br>                swBodyFolder.UpdateCutList<br>                Set GetNextCutList = swFeat<br>                Exit Function<br>            End If<br>            Set swFeat = swFeat.GetNextFeature<br>    Loop<br>    Set GetNextCutList = Nothing<br>End Function<br><br>Function DecimalToInches(DecimalLength As Variant, Denominator As Integer) As String<br>  ' converts decimal inches to feet/inches/fractions<br>  Dim intFeet As Integer<br>  Dim intInches As Integer<br>  Dim intFractions As Integer<br>  Dim FractToDecimal As Double<br>  Dim remainder As Double<br>  Dim tmpVal As Double<br>    <br>  ' compute whole feet<br>  <br>  remainder = DecimalLength<br>  tmpVal = CDbl(Denominator)<br>  <br>  intInches = Int(remainder)<br>  remainder = remainder - intInches<br>  <br>  If Not (remainder = 0) Then<br>    If Not (Denominator = 0) Then<br>      FractToDecimal = 1 / tmpVal<br>        If FractToDecimal > 0 Then<br>          intFractions = Int(remainder / FractToDecimal)<br>          If (remainder / FractToDecimal) - intFractions > 0 Then<br>            intFractions = intFractions + 1<br>          End If<br>        End If<br>     End If<br>  End If<br>  Call FractUp(intFeet, intInches, intFractions, Denominator) ' Simplify up & down<br><br>  If (DecimalToInches <> "" Or intInches <> 0) Then<br>    DecimalToInches = DecimalToInches & LTrim\\\$(Str\\\$(intInches))<br>    If intFractions <> 0 Then<br>      DecimalToInches = DecimalToInches & " "<br>    End If<br>  End If<br>  <br>  <br>  If intFractions > 0 Then<br>    DecimalToInches = DecimalToInches & LTrim\\\$(Str\\\$(intFractions))<br>    DecimalToInches = DecimalToInches & "/" & LTrim\\\$(Str\\\$(Denominator))<br>  End If<br>End Function<br>Function FractUp(InputFt As Integer, InputInch As Integer, InputNum As Integer, InputDenom As Integer)<br>    <br>       'Debug.Print InputFt, InputInch, InputNum, InputDenom<br>  <br>  ' Simplify the fractions, Example: 6/8" becomes 3/4"<br>  While InputNum Mod 2 = 0 And InputDenom Mod 2 = 0<br>    InputNum = InputNum / 2<br>    InputDenom = InputDenom / 2<br>  Wend<br>  <br>  ' See if we now have a full inch or 12 inches.  If so, bump stuff up<br>  If InputDenom = 1 Then  ' Full inch<br>    InputInch = InputInch + 1<br>    InputNum = 0<br>  End If<br>       'Debug.Print InputFt, InputInch, InputNum, InputDenom<br>        <br>End Function