6 Replies Latest reply on Jun 18, 2014 4:13 PM by Wes Cox

    File Handling for Geometrically Identical Parts, Batch Clone to Property Value

    Wes Cox

      Hello,


      Suppose I have 500 red parts, and 500 blue parts, and any given red part = a blue twin. I've created a property during the creation of the red parts that gives the equivelant part number in the blue twin. Now that I have created, scaled, and detailed the red parts and drawings, I want to clone them.

       

      I want to run a macro to open the drawings, rename the reference model configurations "default",  pull the configuration level property blue twin value, rename (clone) the red drawing to the blue twin value, rename the referenced part the blue twin value, close. I'll end up with a folder full of red parts and drawings and a folder of cloned blue twins parts and drawings.

       

      I've spent all mornign trying to create a macro to do this.


      here is the threads I've been referenceing:

       

      https://forum.solidworks.com/message/266358#266358

       

      https://forum.solidworks.com/message/266816#266816

       

      https://forum.solidworks.com/thread/46022

       

      https://forum.solidworks.com/message/431789#431789

       

      Thanks in advance if anyone has ideas on how this might work. I've used pack and go for smaller quantities, but it becomes easy to make errors in this situation almost no matterwhat I do-- if I do this process manually.

        • Re: File Handling for Geometrically Identical Parts, Batch Clone to Property Value
          Deepak Gupta

          Would you mind posting an example of red and blue twin files??

            • Re: File Handling for Geometrically Identical Parts, Batch Clone to Property Value
              Wes Cox

              The Red files are generated from configurations run off the design table, and this is where the blue twin part number is controlled as a configuration level property. I've attached a sample file that includes the design table- the files I'd actually be looking to clone to blue files are like the case of "Red 1001".

               

              Thanks Deepak, If you have a way to crack this one I've got to buy you a drink,

              • Re: File Handling for Geometrically Identical Parts, Batch Clone to Property Value
                Wes Cox

                Deepak,

                 

                I have this working on the part, to rename the configuration in the red part (configuration is currently titled Red part #) to default......................

                 

                Dim swApp As Object

                Sub main()

                 

                    Dim swApp As SldWorks.SldWorks

                    Dim swModel  As ModelDoc2

                    Dim swConfig   As Configuration

                    Dim swConfMgr  As ConfigurationManager

                 

                 

                    Set swApp = Application.SldWorks

                    Set swModel = swApp.ActiveDoc

                    Set swConfMgr = swModel.ConfigurationManager

                    Set swConfig = swConfMgr.ActiveConfiguration

                    swConfig.Name = "Default"

                Set swApp = Application.SldWorks

                End Sub

                 

                 

                Once the configuration is called "Default", I am able to use this macro to rename the part the Blue Part# Configuration level property (I'm calling this property "ACCross" for cross linked designs)

                 

                Dim swApp As Object

                Sub main()

                Dim swApp As SldWorks.SldWorks

                Dim SWmoddoc As SldWorks.ModelDoc2

                Dim ACCross As String

                Set swApp = Application.SldWorks

                Set SWmoddoc = swApp.ActiveDoc

                'Use this....To Get the value from the Properties in the CUSTOM tab

                'ACCross = SWmoddoc.CustomInfo("ACCross")

                'Or this....To Get the value from the Configuration Specific Tab

                ACCross = SWmoddoc.GetCustomInfoValue("Default", "ACCross")

                'athName = SWmoddoc.GetPathName     'this gets the full path of the current open document (including filename)

                'Filepath = Left(PathName, InStrRev(PathName, "\C:SW Working Folder\Wes\Macro Experiment and Documentation\ACCross Tesrt"))  'uses to full pathname to get the folder path, to be added to the save as file name

                If (SWmoddoc.GetType = swDocASSEMBLY) Then

                    SWmoddoc.SaveAs (Filepath + ACCross + ".sldasm")

                 

                ElseIf (SWmoddoc.GetType = swDocPART) Then

                     SWmoddoc.SaveAs (Filepath + ACCross + ".sldprt")

                End If

                End Sub

                 

                 

                But I have yet to find a way to splice these functions into your macro like this one:

                 

                'Save Sheet Metal Part Drawing As DWG (Custom Property).swp ---------------------------------05/17/14

                 

                 

                'Description: Macro to save active drawing as DWG.

                'Precondition: Any active drawing with a view of Sheet Metal Part having specified custom property.

                'Postcondition: Active drawing will be saved as DWG along with custom property values in the file name in same location as the drawing file.

                 

                 

                ' Please back up your data before use and USE AT OWN RISK

                 

                 

                ' This macro is provided as is.  No claims, support, refund, safety net, or

                ' warranties are expressed or implied.  By using this macro and/or its code in

                ' any way whatsoever, the user and any entities which the user represents,

                ' agree to hold the authors free of any and all liability.  Free distribution

                ' and use of this code in other free works is welcome.  If any portion of

                ' this code is used in other works, credit to the authors must be placed in

                ' that work within a user viewable location (e.g., macro header).  All other

                ' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited

                ' without the expressed written consent by the authors.  Use at your own risk!

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

                ' Written by: Deepak Gupta (http://gupta9665.com/)

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

                Option Explicit

                 

                 

                Sub main()

                 

                 

                Dim swApp           As SldWorks.SldWorks

                Dim swModel         As SldWorks.ModelDoc2

                Dim swDrawModel     As SldWorks.ModelDoc2

                Dim swDraw          As SldWorks.DrawingDoc

                Dim swView          As SldWorks.View

                Dim swFeat          As SldWorks.Feature

                Dim swBaseFlange    As SldWorks.BaseFlangeFeatureData

                Dim Filepath        As String

                Dim sModelName      As String

                Dim sFileName       As String

                Dim Fileprop       As String

                Dim sConfig         As String

                Dim PartThickness   As String

                Dim sMatName        As String

                Dim sMatDB          As String

                 

                 

                 

                 

                Set swApp = Application.SldWorks

                Set swDrawModel = swApp.ActiveDoc

                 

                 

                ' Check to see if a drawing is loaded.

                If swDrawModel Is Nothing Then

                        MsgBox "There is no active drawing document"

                        Exit Sub

                End If

                 

                If swDrawModel.GetType <> swDocDRAWING Then

                        MsgBox "Open a drawing first and then TRY again!"

                        Exit Sub

                End If

                 

                 

                Set swDraw = swDrawModel

                 

                 

                Set swView = swDraw.GetFirstView

                Set swView = swView.GetNextView

                Set swModel = swView.ReferencedDocument

                sModelName = swView.GetReferencedModelName

                 

                 

                ' Determine if there is any view

                If sModelName = "" Then

                        MsgBox "Insert a SheetMetal Part View first and then TRY again!"

                        Exit Sub

                End If

                 

                 

                ' Determine if this is a view of a part or assembly

                sModelName = LCase(sModelName)

                If InStr(sModelName, ".sldasm") Then

                    MsgBox "Worsks only for SheetMetal Part Drawings!"

                    Exit Sub

                Else

                 

                 

                sConfig = swView.ReferencedConfiguration

                 

                 

                Set swFeat = swModel.FirstFeature

                Do While Not swFeat Is Nothing

                        ' Process top-level sheet metal features

                        Select Case swFeat.GetTypeName

                            Case "SMBaseFlange"

                                Set swBaseFlange = swFeat.GetDefinition

                                PartThickness = swBaseFlange.ThicknessTableName

                                PartThickness = Right(PartThickness, Len(PartThickness) - 6)

                 

                 

                Case Else

                 

                End Select

                 

                        Set swFeat = swFeat.GetNextFeature

                Loop

                 

                 

                 

                 

                Fileprop = swModel.CustomInfo2(sConfig, "SWBOMPARTNO")  'Change the custom property name here

                ' Get Material details

                sMatName = swModel.GetMaterialPropertyName2(sConfig, sMatDB)

                 

                 

                Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

                 

                 

                sFileName = Filepath + Fileprop + "_" + PartThickness + "_" + sMatName + ".dwg"

                 

                 

                        If Dir(sFileName) <> "" Then

                            MsgBox "File Already Exists"

                    Else

                        swDraw.SaveAs sFileName

                        End If

                End If

                 

                End Sub

                 

                 

                 

                Or this one:

                 

                 

                'Save Referenced Model As STEP.swp ------------- 05/31/14

                 

                 

                'Description: Macro to save referenced docuemnt in the current active drawing as STEP file.

                 

                 

                'Pre-Condition: An open drawing with one view.

                 

                 

                'Post-Condition: Macro will update the save the referenced model as STEP file in same location as the model file.

                 

                 

                'Please back up your data before use and USE AT OWN RISK

                 

                 

                ' This macro is provided as is.  No claims, support, refund, safety net, or

                ' warranties are expressed or implied.  By using this macro and/or its code in

                ' any way whatsoever, the user and any entities which the user represents,

                ' agree to hold the authors free of any and all liability.  Free distribution

                ' and use of this code in other free works is welcome.  If any portion of

                ' this code is used in other works, credit to the authors must be placed in

                ' that work within a user viewable location (e.g., macro header).  All other

                ' forms of distribution (i.e., not free, fee for delivery, etc.) are prohibited

                ' without the expressed written consent by the authors.  Use at your own risk!

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

                ' Written by: Deepak Gupta (http://gupta9665.com/)

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

                 

                 

                Option Explicit

                 

                 

                Sub main()

                 

                 

                Dim swApp           As SldWorks.SldWorks

                Dim swModel         As SldWorks.ModelDoc2

                Dim swDrawModel     As SldWorks.ModelDoc2

                Dim swDraw          As SldWorks.DrawingDoc

                Dim swView          As SldWorks.View

                Dim nErrors         As Long

                Dim nWarnings       As Long

                 

                 

                Set swApp = Application.SldWorks

                Set swDrawModel = swApp.ActiveDoc

                 

                 

                ' Check to see if a drawing is loaded.

                If swDrawModel Is Nothing Then

                        MsgBox "There is no active drawing document"

                        Exit Sub

                End If

                 

                If swDrawModel.GetType <> swDocDRAWING Then

                        MsgBox "Open a drawing first and then TRY again!"

                        Exit Sub

                End If

                 

                 

                Set swDraw = swDrawModel

                Set swView = swDraw.GetFirstView

                Set swView = swView.GetNextView

                Set swModel = swView.ReferencedDocument

                 

                 

                ' Determine if there is any view

                If swModel.GetPathName = "" Then

                        MsgBox "Insert a View first and then TRY again!"

                        Exit Sub

                End If

                 

                 

                If Dir(Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & ".step") <> "" Then

                  MsgBox "STEP File already exists!"

                        Exit Sub

                  Else

                        swModel.Extension.SaveAs Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1) & ".step", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, nErrors, nWarnings

                End If

                 

                 


                Am I on the wrong track trying to combine these?

                 

                 

                Thank you,


                Wes