Crear Carpetas desde un archivo Excel en SW

JUAN ESPINOSA

18 Apr, 2024 12:30 PM

Te enseño como crear carpetas en SolidWorks para un mejor control y organización.

1. Step 1: Descargar la macro

   'Copia este código:

   
   

   Dim swApp      As Object

   Dim Part      As Object

   Dim boolstatus   As Boolean

   Dim longstatus   As Long, longwarnings As Long

   Dim cellValue    As Variant

   Dim rng       As Object

   Dim cell      As Object

   
   

   Sub main()

     Set swApp = Application.SldWorks

     Set Part = swApp.ActiveDoc

      

     ' Crea un círculo en un plano

     boolstatus = Part.Extension.SelectByID2("Alzado", "PLANE", 0, 0, 0, False, 0, Nothing, 0)

     Part.SketchManager.InsertSketch TRUE

     Dim skSegment  As Object

     Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, -0.076247, 0.00858, 0#)

     Part.ClearSelection2 TRUE

      

     ' Crea la operación de extrusión

     Dim myFeature  As Object

     Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.01, 0.01, False, False, False, False, 1.74532925199433E-02, 1.74532925199433E-02, False, False, False, False, True, True, True, 0, 0, False)

      

     ' Definir la hoja de Excel y el rango de celdas a procesar

     Dim excelApp  As Object

     Set excelApp = CreateObject("Excel.Application")

     excelApp.Visible = FALSE    ' Hacer que Excel no sea visible

     Dim excelBook  As Object

     Set excelBook = excelApp.Workbooks.Open("Tu ruta de acceso")

     Dim excelSheet As Object

     Set excelSheet = excelBook.Sheets("Sheet1")

     Set rng = excelSheet.Range("A1:A30")    ' Ajusta el rango según sea necesario

      

     boolstatus = Part.Extension.SelectByID2("Saliente-Extruir1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)

      

     For Each cell In rng

       cellValue = cell.Value

        

       'Set myFeature = Part.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_Containing)

       Set myFeature = Part.FeatureManager.InsertFeatureTreeFolder2(swFeatureTreeFolderType_e.swFeatureTreeFolder_EmptyBefore)

        

       boolstatus = Part.SelectedFeatureProperties(0, 0, 0, 0, 0, 0, 0, 1, 0, cell.Value)

        

       boolstatus = Part.Extension.SelectByID2(cell.Value, "FTRFOLDER", 0, 0, 0, False, 0, Nothing, 0)

        

     Next cell

      

     ' Eliminar la operación creada

     boolstatus = Part.Extension.SelectByID2("Saliente-Extruir1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)

     Part.EditDelete

      

     ' Cerrar Excel y liberar los objetos

     excelBook.Close FALSE

     excelApp.Quit

     Set excelSheet = Nothing

     Set excelBook = Nothing

     Set excelApp = Nothing

      

     ' Limpia la selección y el modo de selección en SolidWorks

     Part.SelectionManager.EnableContourSelection = FALSE

     Part.SetPickMode

     Part.ClearSelection2 TRUE

      

     boolstatus = Part.Extension.SelectByID2("Croquis1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

     Part.EditDelete

     boolstatus = Part.EditRebuild3()

   End Sub

   
   

   
   

   Activa la casilla de macro:

   

   
   

   Click en nueva macro, nómbrala y guárdala donde desees.

   A continuación haz click en editar macro y selecciona la que creaste.

   
   

   

   
   

   Pega el código que copiaste.

2. Step 2: Abrir un archivo Excel

   Crea un archivo Excel y escribe el nombre de todas las carpetas que quieres tener en la columna A.

   

   
   

3. Step 3: Modificar la macro y ejecutar

   Copia la ruta de acceso del archivo Excel. Selecciona tu archivo y Crt+Shift+C

   Pégala en donde dice: "Tu ruta de acceso" en el código

   
   

   Modifica el rango de columnas deberá ser de "An:An" siendo n el numero de carpetas.

   Set rng = excelSheet.Range("A1:A30")    ' Ajusta el rango según sea necesario

   
   

   Guarda la macro y selecciona Ejecutar la macro.

   Se va a crear una lista de carpetas con los nombres del archivo de Excel que escribiste.