6 Replies Latest reply on Oct 16, 2015 1:37 PM by Deepak Gupta

    Macro to turn off "rename cutlist folders..." document property

    Shaun Jalbert

      I'm looking for a way to quickly turn off the "Rename cutlist folders with description property value" located in the document properties.

      I'm thinking of a macro, but can't determine how to toggle the property. Any idea's?

        • Re: Macro to turn off "rename cutlist folders..." document property
          Deepak Gupta

          Option Explicit

          Dim swApp   As SldWorks.SldWorks

          Dim Part    As SldWorks.ModelDoc2

          Dim bRet    As Boolean

          Sub Main()

           

          Set swApp = Application.SldWorks

          Set Part = swApp.ActiveDoc

           

          bRet = Part.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified)

           

          If bRet = True Then

          Part.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified, False

          Else

          Part.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified, True

          End If

           

          End Sub

            • Re: Macro to turn off "rename cutlist folders..." document property
              Shaun Jalbert

              Hi Deepak. Thanks for getting back to me. I tried integrating your code into one of my scripts and two issues exist.

              1) If I run the script once, it works good and turns off the toggle. But if I run it a second time, the option turns back on. I need it to always be off, perhaps check if it's off first or something. Any idea's?

               

              2) I'm attaching my script, but when I put your code in, the first folder will not rename as per my script, however the second and other successing folder do rename ok. Is there a way to have your code take priority in the script and run before anything else does?

               

               

              ---------------------------------------------------------------------------

               

              Option Explicit

              Private Const propname1 As String = "Mass" ' change to "MASS" or whatever you prefer

              Private Const propname2 As String = "Description"

              Private Const propname3 As String = "Type"

              Private Const propname4 As String = "StockSize"

              Private Const propname5 As String = "Grade"

              Private Const propname6 As String = "Length"

              Private Const propname7 As String = "Mark"

              Private Const propname8 As String = "PARTNUMBER"

              Private Const propname9 As String = "Sheet Metal Thickness"

              Private Const propname10 As String = "ANGLE1"

              Private Const propname11 As String = "StockSize_Short"

              Private Const proptype As String = "Text" ' in english you must change to "Text". See comment in code…

               

               

              Dim swApp As Object

              Sub Main()

              Dim swApp As SldWorks.SldWorks

              Set swApp = Application.SldWorks

              Dim doc As SldWorks.ModelDoc2: Set doc = swApp.ActiveDoc

              Dim partdoc As SldWorks.partdoc: Set partdoc = doc

              Dim f As IFeature: Set f = doc.FirstFeature

              Dim bRet As Boolean

              Dim n As Integer: n = 0

              Dim num As String

               

              Dim modDocExt As SldWorks.ModelDocExtension

               

              Dim Part As Object

              Dim boolstatus As Boolean

               

              Dim BodyFolder As SldWorks.BodyFolder

              Dim BodyCount As Long

               

              'This is Depaks code to turn off "Rename cutlist folders..." document property to rename folders.

              Set Part = swApp.ActiveDoc

              bRet = Part.Extension.GetUserPreferenceToggle(swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified)

              If bRet = True Then

              Part.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified, False

              Else

              Part.Extension.SetUserPreferenceToggle swUserPreferenceToggle_e.swWeldmentRenameCutlistDescriptionPropertyValue, swDetailingNoOptionSpecified, True

              End If

               

               

              Do While Not f Is Nothing

              If f.GetTypeName = "CutListFolder" Then

                      Set BodyFolder = f.GetSpecificFeature2

                      BodyCount = BodyFolder.GetBodyCount

                  If BodyCount > 0 Then

                      n = n + 1

                      If n < 1000 Then

                      num = "-" + Right(Str$(n), Len(Str$(n)) - 1)

                      End If

                      If n < 100 Then

                      num = "-" + Right(Str$(n), Len(Str$(n)) - 1)

                      End If

                      If n < 10 Then

                      num = "-0" + Right(Str$(n), Len(Str$(n)) - 1)

                  End If

              End If

               

              Dim swConfig As SldWorks.Configuration

              Dim sValue As String

               

              Set swConfig = doc.GetActiveConfiguration

              sValue = ""

              sValue = GetCustomProp(doc, "WLD_MK_NO", swConfig)

              'Debug.Print ("The Folder Name Is: " + sValue + num)

              f.Name = sValue + num

               

               

              'add 3d bounding box

                Set Part = swApp.ActiveDoc

                Set modDocExt = Part.Extension

                boolstatus = modDocExt.SelectByID2(f.Name, "SUBWELDFOLDER", 0, 0, 0, False, 0, Nothing, 0)

                modDocExt.Create3DBoundingBox

               

                       

                           

                              'del Mark and PARTNUMBER

                              bRet = f.CustomPropertyManager.Delete(propname7)

                              bRet = f.CustomPropertyManager.Delete(propname8)

                           

                              'mass

                              bRet = f.CustomPropertyManager.Delete(propname1)

                              bRet = f.CustomPropertyManager.Add(propname1, proptype, Chr$(34) + "SW-Mass@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                              'bRet = f.CustomPropertyManager.Add(propname1, proptype, Chr$(34) + "SW-Mass@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + " kg")

                              'If f.CustomPropertyManager.Add(propname1, proptype, Chr$(34) + "SW-Mass@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + "kg") Then

                              'Debug.Print "Property "; propname1; " added to feature "; f.Name

                              'End If

                           

                              'desc

                              'If f.CustomPropertyManager.Add(propname2, proptype, "PLATE") Then

                              'Debug.Print "Property "; propname2; " added to feature "; f.Name

                              'End If

                           

                              'type

                              If f.CustomPropertyManager.Add(propname3, proptype, "PL") Then

                              Debug.Print "Property "; propname3; " added to feature "; f.Name

                              End If

                           

                           

                              'Plate & Formed Plate stocksize and Length and desc

                              If f.CustomPropertyManager.Get(propname10) = "" Then

                                If f.CustomPropertyManager.Get(propname9) = "" Then

                                    bRet = f.CustomPropertyManager.Delete(propname4)

                                    bRet = f.CustomPropertyManager.Add(propname4, proptype, Chr$(34) + "PL" + "SW-3D-Bounding Box Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + "x" + Chr(34) + "SW-3D-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                                    bRet = f.CustomPropertyManager.Add(propname11, proptype, Chr$(34) + "PL" + "SW-3D-Bounding Box Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                                    bRet = f.CustomPropertyManager.Delete(propname6)

                                    bRet = f.CustomPropertyManager.Add(propname6, proptype, Chr$(34) + "SW-3D-Bounding Box Length@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                                 

                                    'desc plate

                                    bRet = f.CustomPropertyManager.Delete(propname2)

                                    bRet = f.CustomPropertyManager.Add(propname2, proptype, "PLATE")

               

                                    'If f.CustomPropertyManager.Add(propname4, proptype, Chr$(34) + "SW-3D-Bounding Box Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + "x" + Chr(34) + "SW-3D-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34)) Then

                                    'Debug.Print "Property "; propname4; " added to feature "; f.Name

                                    'End If

                                Else

                                    bRet = f.CustomPropertyManager.Delete(propname4)

                                    bRet = f.CustomPropertyManager.Add(propname4, proptype, Chr$(34) + "PL" + "SW-Sheet Metal Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + "x" + Chr(34) + "SW-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                                    bRet = f.CustomPropertyManager.Add(propname11, proptype, Chr$(34) + "PL" + "SW-Sheet Metal Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

               

                                    bRet = f.CustomPropertyManager.Delete(propname6)

                                    bRet = f.CustomPropertyManager.Add(propname6, proptype, Chr$(34) + "SW-Bounding Box Length@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                                 

                                    'desc formed plate

                                    bRet = f.CustomPropertyManager.Delete(propname2)

                                    bRet = f.CustomPropertyManager.Add(propname2, proptype, "FORMED PLATE")

                                 

                                    'If f.CustomPropertyManager.Add(propname4, proptype, Chr$(34) + "SW-Sheet Metal Thickness@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34) + "x" + Chr(34) + "SW-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34)) Then

                                    'Debug.Print "Property "; propname4; " added to feature "; f.Name

                                    'End If

                                End If

                              Else

                              End If

                         

                              'grade

                              If f.CustomPropertyManager.Add(propname5, proptype, Chr$(34) + "SW-Material@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34)) Then

                              Debug.Print "Property "; propname5; " added to feature "; f.Name

                              End If

                             

                              'Let's see if the material is grating

                               Dim sGRTGMaterial As String

                               sGRTGMaterial = GetFeatureCustomProp("Material", f)

                               If Not sGRTGMaterial = "" Then

                               Dim iPGRTG As Integer

                               iPGRTG = InStr(1, sGRTGMaterial, "GRTG")

                                  'If the material is grating then let's change the values

                                  If iPGRTG > 0 Then

                                  ChangeCustomPropForGrating sGRTGMaterial, f

                                  End If 'End of material being grating if

                               End If 'End of material being blank if

                         

                              'Let's see if the material is expanded metal

                               Dim sExpMetalMaterial As String

                               sExpMetalMaterial = GetFeatureCustomProp("Material", f)

                               If Not sExpMetalMaterial = "" Then

                               Dim iPExpMetal As Integer

                               iPExpMetal = InStr(1, sExpMetalMaterial, "EXP METAL")

                                  'If the material is expanded metal then let's change the values

                                  If iPExpMetal > 0 Then

                                  ChangeCustomPropForExpMet sExpMetalMaterial, f

                                  End If 'End of material being expanded metal if

                               End If 'End of material being blank if

                                                                                                            

              End If

              Set f = f.GetNextFeature

              Loop

              End Sub

               

              Function GetCustomProp(ByVal TheModel As SldWorks.ModelDoc2, ByVal sPropertyToGet As String, ByVal TheConfig As SldWorks.Configuration) As String

              Dim swCustPropMgr As SldWorks.CustomPropertyManager

              Dim iRet As Integer

              Dim sValOut As String

              Dim sResolved As String

              Dim bResolved As Boolean

              GetCustomProp = ""

              TheModel.ShowConfiguration2 TheConfig.Name

              Set swCustPropMgr = TheModel.Extension.CustomPropertyManager("")

              iRet = swCustPropMgr.Get5(sPropertyToGet, True, sValOut, sResolved, bResolved)

              If iRet = 2 Then

                GetCustomProp = sValOut

              End If

              End Function

               

              Function GetFeatureCustomProp(ByVal sPropertyToGet As String, ByVal TheFeature As SldWorks.Feature) As String

              Dim swCustPropMgr As SldWorks.CustomPropertyManager

              Dim sTextExp As String

              Dim sEvalVal As String

              GetFeatureCustomProp = ""

              Set swCustPropMgr = TheFeature.CustomPropertyManager

              swCustPropMgr.Get2 sPropertyToGet, sTextExp, sEvalVal

              GetFeatureCustomProp = sEvalVal

              End Function

               

              Sub ChangeCustomPropForGrating(ByVal TheGRTGMaterial As String, ByVal TheGRTGFeature As SldWorks.Feature)

              Dim swApp As SldWorks.SldWorks

              Set swApp = Application.SldWorks

              Dim bRet                As Boolean

              Dim iGrtg               As Integer

              Dim iSpace              As Integer

              Dim sGrade              As String

              Dim sStockSize          As String

              Dim sStockSize_Short    As String

              Dim sType               As String

              Dim doc As SldWorks.ModelDoc2: Set doc = swApp.ActiveDoc

              Dim f As IFeature: Set f = doc.FirstFeature

               

              sType = "GRTG"

              iGrtg = InStrRev(TheGRTGMaterial, sType)

              If iGrtg > 0 Then

                 iSpace = InStr(1, TheGRTGMaterial, " ")

                 sGrade = Left(TheGRTGMaterial, iSpace - 1)

                 sStockSize = sGrade + " " + Trim(Mid(TheGRTGMaterial, iSpace, iGrtg - iSpace))

                 sStockSize_Short = sGrade + " " + Trim(Mid(TheGRTGMaterial, iSpace, iGrtg - iSpace))

                 bRet = TheGRTGFeature.CustomPropertyManager.Set2(propname5, sGrade)

                 bRet = TheGRTGFeature.CustomPropertyManager.Set2(propname4, sStockSize + " x " + Chr$(34) + "SW-3D-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                 bRet = TheGRTGFeature.CustomPropertyManager.Set2(propname11, sStockSize_Short)

                 bRet = TheGRTGFeature.CustomPropertyManager.Set2(propname3, sType)

                 bRet = TheGRTGFeature.CustomPropertyManager.Set2(propname2, "BAR GRATING")

              End If

              End Sub

               

              Sub ChangeCustomPropForExpMet(ByVal TheExpMetMaterial As String, ByVal TheExpMetFeature As SldWorks.Feature)

              Dim swApp As SldWorks.SldWorks

              Set swApp = Application.SldWorks

              Dim bRet                As Boolean

              Dim iExpMetal           As Integer

              Dim iSpace              As Integer

              Dim sGrade              As String

              Dim sStockSize          As String

              Dim sStockSize_Short    As String

              Dim sType               As String

              Dim doc As SldWorks.ModelDoc2: Set doc = swApp.ActiveDoc

              Dim f As IFeature: Set f = doc.FirstFeature

               

              sType = "EXP METAL"

              iExpMetal = InStrRev(TheExpMetMaterial, sType)

              If iExpMetal > 0 Then

                 sStockSize_Short = Left(TheExpMetMaterial, iExpMetal - 2)

                 sGrade = Mid(TheExpMetMaterial, iExpMetal + Len(sType) + 2, 2)

                 bRet = TheExpMetFeature.CustomPropertyManager.Set2(propname5, sGrade)

                 bRet = TheExpMetFeature.CustomPropertyManager.Delete(propname4)

                 bRet = TheExpMetFeature.CustomPropertyManager.Add(propname4, proptype, sStockSize_Short + " " + sType + " x " + Chr$(34) + "SW-3D-Bounding Box Width@@@" + f.Name + "@" + doc.GetTitle + ".SLDPRT" + Chr(34))

                 bRet = TheExpMetFeature.CustomPropertyManager.Set2(propname11, sStockSize_Short + " " + sType)

                 bRet = TheExpMetFeature.CustomPropertyManager.Set2(propname3, sType)

                 bRet = TheExpMetFeature.CustomPropertyManager.Set2(propname2, "EXPANDED METAL")

              End If

              End Sub