AnsweredAssumed Answered

Run a macro on all files in a folder

Question asked by Axel Hedman on Feb 14, 2017
Latest reply on Feb 20, 2017 by Deepak Gupta

Like • Show 0 Likes0
Comment • 11

Hi, I have a number of parts and assemblies i need to make drawings of.

There is a monotone task of writing properties in all models and then make a drawing on each one.

I want to make this process somewhat automated. So far I have managed to make this macro (I have no idea what Im doing, much copy and paste from this forum, but it seems to work.)

I have found that schedule manager can make drawings from all parts, that sound good.

However, I still don´t get how I make this macro run on all the files in one folder.

Can someone help me?

This is the code I want to run on all files:

Dim swApp As SldWorks.SldWorks

Dim swModel As ModelDoc2

Sub main()

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

'Check and Add/Update Number Property

If swModel.CustomInfo("Number") = "" Then

swModel.AddCustomInfo2 "Number", swCustomInfoText, (swModel.GetTitle)

Else

swModel.CustomInfo("Number") = (swModel.GetTitle)

End If

If swModel.CustomInfo("DrawnBy") = "" Then

swModel.AddCustomInfo2 "DrawnBy", swCustomInfoText, "AHe / Devex"

Else

swModel.CustomInfo("DrawnBy") = "AHe / Devex"

End If

If swModel.CustomInfo("Surface finish") = "" Then

swModel.AddCustomInfo2 "Surface finish", swCustomInfoText, "Ready for paint"

Else

swModel.CustomInfo("Surface finish") = "Ready for paint"

End If

If swModel.CustomInfo("General Tolerances") = "" Then

swModel.AddCustomInfo2 "General Tolerances", swCustomInfoText, "SS-ISO 2768-1-m"

Else

swModel.CustomInfo("General Tolerances") = "SS-ISO 2768-1-m"

End If

If swModel.CustomInfo("Project") = "" Then

swModel.AddCustomInfo2 "Project", swCustomInfoText, "P0988"

Else

swModel.CustomInfo("Project") = "P0988"

End If

End Sub

No one else has this question

Outcomes

Andreas Rhomberg Feb 14, 2017 9:42 AM

have you looked at TASK, http://centralinnovation.com.au/ for writing all the Properties to the files.

It is a free program and works well.

Actions

John Stoltzfus Feb 14, 2017 9:51 AM

Don't you use Custom Property Tab Builder ??

I would use the attached macro written by Markku Lehtola

Attachments

SW_Import_Export Properties-Default.xls253.5 KB

Actions

Deepak Gupta Feb 14, 2017 10:02 AM

Axel, yes you should be able to use the #TASK tool to run your own macros and can run on the entire folder (can also set which file type to run the macro on).

I've also reduced the size of your macro. Add3 will add/update the properties with the required values.

Option Explicit
Dim swApp                        As SldWorks.SldWorks
Dim swModel                      As SldWorks.ModelDoc
Dim swCustProp              As CustomPropertyManager

Sub main() 
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swCustProp = swModel.Extension.CustomPropertyManager("")

    'Check and Add/Update Properties
    swCustProp.Add3 "Number", 30, swModel.GetTitle, 1
    swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1
    swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1
    swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1
    swCustProp.Add3 "Project", 30, "P0988", 1

    swModel.Save
End Sub

Actions

Axel Hedman Feb 14, 2017 10:47 AM

Okay I tried #TASK but so far it does not seem to work. It only says that the part was not modified saving is skipped.

However, when searching I found that this macro are supposed to open all parts in a specific folder

Dim swApp As SldWorks.SldWorks
Dim swDoc As ModelDoc2
Dim fileerror As Long
Dim filewarning As Long
Const folder As String = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\"
Dim files As Variant
Sub main()
Set swApp = Application.SldWorks
files = Dir(folder & "*.sldprt", vbNormal)
Do While files <> ""
swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning
files = Dir
Loop
End Sub

But I don´t get what is what, can i put my macro somwhere in that macro?

That macro is from this thread: Run Macro in Task Scheduler

Actions

Deepak Gupta @ Axel Hedman on Feb 14, 2017 11:09 AM

Not sure why #TASK would fail. Anyway try these codes

Option Explicit
 Dim swApp              As SldWorks.SldWorks
Dim swModel            As SldWorks.ModelDoc2
Dim sFileName          As String
Dim Path                As String
Dim nErrors            As Long
Dim nWarnings          As Long
Dim swCustProp          As CustomPropertyManager

Sub main()
On Error Resume Next

Set swApp = Application.SldWorks
Path = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\" 'Change path here and make sure you include \ at end of path.

sFileName = Dir(Path & "*.sldprt")
Do Until sFileName = ""
Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swModel = swApp.ActiveDoc
Set swCustProp = swModel.Extension.CustomPropertyManager("") 

    'Check and Add/Update Properties 
    swCustProp.Add3 "Number", 30, swModel.GetTitle, 1 
    swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1 
    swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1 
    swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1 
    swCustProp.Add3 "Project", 30, "P0988", 1

swModel.Save3 swSaveAsOptions_Silent, nErrors, nWarnings
swApp.CloseDoc swModel.GetTitle
Set swModel = Nothing
sFileName = Dir
Loop
End Sub

Actions

Artem Taturevych @ Axel Hedman on Feb 14, 2017 5:39 PM

Hi Axel,

#TASK only saves the file when it sees it was modified. The AddCustomInfo2 API doesn't mark the model as dirty (i.e. modified). You can check this by running the macro on a active saved model and you will see that the * symbol is not added to the name and SOLIDWORKS doesn't ask you to save the model when you close it. You can forcibly set the dirty flag using SetSaveFlag API. In this case #TASK will successfully save the modified file. You simply need to add one line to the end of your macro.

If swModel.CustomInfo("Project") = "" Then
      swModel.AddCustomInfo2 "Project", swCustomInfoText, "P0988"
    Else
        swModel.CustomInfo("Project") = "P0988"
    End If

    swModel.SetSaveFlag

Thanks,

Atrem

Actions

Axel Hedman Feb 17, 2017 8:09 AM

Alright! I have started to get things going here!

I use the neat code i got from Deepak Gupta

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc
Dim swCustProp As CustomPropertyManager
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustProp = swModel.Extension.CustomPropertyManager("")
'Check and Add/Update Properties
swCustProp.Add3 "Number", 30, swModel.GetTitle, 1
swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1
swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1
swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1
swCustProp.Add3 "Project", 30, "P0988", 1
swModel.Save
End Sub

And by adding the swModel.SetSaveFlag I got from Artem Taturevych I got it to work with #TASK

However! Now I want to make a new nuber from the existing part number:

I want 012.0067-00 to become 120067S0 ie I want to remove the first "0", then remove the "." and then change the "-0" to "S"

I have seen that its possible but i don´t get how it works :/

Actions

Deepak Gupta @ Axel Hedman on Feb 19, 2017 12:10 PM

You can use Replace function.

Replace(Replace(Replace(swModel.GetTitle, "-0", "S"), ".", ""), "0", "", 1, 1)

Actions

Axel Hedman @ Deepak Gupta on Feb 20, 2017 7:15 AM

Oh okay, but how do I implement that in a swCustProp.Add3 statement?

Actions

Deepak Gupta @ Axel Hedman on Feb 20, 2017 8:32 AM

Here is how you can use it

swCustProp.Add3 "Number", 30, Replace(Replace(Replace(swModel.GetTitle, "-0", "S"), ".", ""), "0", "", 1, 1), 1

Actions

10 Replies

Andreas Rhomberg Feb 14, 2017 9:42 AM
Mark Correct
Correct Answer
have you looked at TASK, http://centralinnovation.com.au/ for writing all the Properties to the files.
It is a free program and works well.
Like • Show 1 Like1
Actions
John Stoltzfus Feb 14, 2017 9:51 AM
Mark Correct
Correct Answer
Don't you use Custom Property Tab Builder ??

I would use the attached macro written by Markku Lehtola
Attachments
- SW_Import_Export Properties-Default.xls253.5 KB
Like • Show 0 Likes0
Actions

Axel Hedman Feb 14, 2017 10:47 AM
Mark Correct
Correct Answer
Okay I tried #TASK but so far it does not seem to work. It only says that the part was not modified saving is skipped.
However, when searching I found that this macro are supposed to open all parts in a specific folder
1. Dim swApp As SldWorks.SldWorks
2. Dim swDoc As ModelDoc2
3. Dim fileerror As Long
4. Dim filewarning As Long
6. Const folder As String = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\"
7. Dim files As Variant
9. Sub main()
10. Set swApp = Application.SldWorks
11. files = Dir(folder & "*.sldprt", vbNormal)
12. Do While files <> ""
13. swApp.OpenDoc6 folder & files, swDocPART, 0, "", fileerror, filewarning
14. files = Dir
15. Loop
16. End Sub
But I don´t get what is what, can i put my macro somwhere in that macro?
That macro is from this thread: Run Macro in Task Scheduler
Like • Show 0 Likes0
Actions
- Deepak Gupta @ Axel Hedman on Feb 14, 2017 11:09 AM
  Mark Correct
  Correct Answer
  Not sure why #TASK would fail. Anyway try these codes
  
  Option Explicit Dim swApp As SldWorks.SldWorks Dim swModel As SldWorks.ModelDoc2 Dim sFileName As String Dim Path As String Dim nErrors As Long Dim nWarnings As Long Dim swCustProp As CustomPropertyManager Sub main() On Error Resume Next Set swApp = Application.SldWorks Path = "C:\SolidWorks Training Files\Essentials\Lesson01\Case Study\" 'Change path here and make sure you include \ at end of path. sFileName = Dir(Path & "*.sldprt") Do Until sFileName = "" Set swModel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings) Set swModel = swApp.ActiveDoc Set swCustProp = swModel.Extension.CustomPropertyManager("") 'Check and Add/Update Properties swCustProp.Add3 "Number", 30, swModel.GetTitle, 1 swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1 swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1 swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1 swCustProp.Add3 "Project", 30, "P0988", 1 swModel.Save3 swSaveAsOptions_Silent, nErrors, nWarnings swApp.CloseDoc swModel.GetTitle Set swModel = Nothing sFileName = Dir Loop End Sub
  Like • Show 1 Like1
  Actions
- Artem Taturevych @ Axel Hedman on Feb 14, 2017 5:39 PM
  Mark Correct
  Correct Answer
  Hi Axel,
  
  #TASK only saves the file when it sees it was modified. The AddCustomInfo2 API doesn't mark the model as dirty (i.e. modified). You can check this by running the macro on a active saved model and you will see that the * symbol is not added to the name and SOLIDWORKS doesn't ask you to save the model when you close it. You can forcibly set the dirty flag using SetSaveFlag API. In this case #TASK will successfully save the modified file. You simply need to add one line to the end of your macro.
  
  If swModel.CustomInfo("Project") = "" Then
        swModel.AddCustomInfo2 "Project", swCustomInfoText, "P0988"
      Else
          swModel.CustomInfo("Project") = "P0988"
      End If
  
      swModel.SetSaveFlag
  Thanks,
  Atrem
  Like • Show 3 Likes3
  Actions
Axel Hedman Feb 17, 2017 8:09 AM
Mark Correct
Correct Answer
Alright! I have started to get things going here!
I use the neat code i got from Deepak Gupta
1. Option Explicit
2. Dim swApp As SldWorks.SldWorks
3. Dim swModel As SldWorks.ModelDoc
4. Dim swCustProp As CustomPropertyManager
6. Sub main()
7. Set swApp = Application.SldWorks
8. Set swModel = swApp.ActiveDoc
9. Set swCustProp = swModel.Extension.CustomPropertyManager("")
11. 'Check and Add/Update Properties
12. swCustProp.Add3 "Number", 30, swModel.GetTitle, 1
13. swCustProp.Add3 "DrawnBy", 30, "AHe / Devex", 1
14. swCustProp.Add3 "Surface finish", 30, "Ready for paint", 1
15. swCustProp.Add3 "General Tolerances", 30, "SS-ISO 2768-1-m", 1
16. swCustProp.Add3 "Project", 30, "P0988", 1
18. swModel.Save
19. End Sub
And by adding the swModel.SetSaveFlag I got from Artem Taturevych I got it to work with #TASK

However! Now I want to make a new nuber from the existing part number:
I want 012.0067-00 to become 120067S0 ie I want to remove the first "0", then remove the "." and then change the "-0" to "S"
I have seen that its possible but i don´t get how it works :/
Like • Show 1 Like1
Actions
- Deepak Gupta @ Axel Hedman on Feb 19, 2017 12:10 PM
  Mark Correct
  Correct Answer
  You can use Replace function.
  
  Replace(Replace(Replace(swModel.GetTitle, "-0", "S"), ".", ""), "0", "", 1, 1)
  Like • Show 0 Likes0
  Actions
  - Axel Hedman @ Deepak Gupta on Feb 20, 2017 7:15 AM
    Mark Correct
    Correct Answer
    Oh okay, but how do I implement that in a swCustProp.Add3 statement?
    Like • Show 0 Likes0
    Actions
    - Deepak Gupta @ Axel Hedman on Feb 20, 2017 8:32 AM
      Mark Correct
      Correct Answer
      Here is how you can use it
      swCustProp.Add3 "Number", 30, Replace(Replace(Replace(swModel.GetTitle, "-0", "S"), ".", ""), "0", "", 1, 1), 1
      Like • Show 0 Likes0
      Actions

Run a macro on all files in a folder

Outcomes

Attachments

Related Content

Recommended Content