Macro help

I would like to be lead in the direction of the macro code that...

The macro would:
1. open a drawing file
2. complete some tasks I have written code for
3. close and save the drawing
4. cycle through all the drawings in the folder and complete tasks 1 thru 3

Does anyone have a macro that does this or can lead me into the code to
do such a thing? Also things I would like to be able to do with this
code, would be to be able to open parts, and or assemblies, and or
drawings and any combination of the above

Ben

 

Strangely enough that was presented at SWW2006. Earl Hasz was the
presenter. You will need a C# compiler and .NET 2.2 to get it going.
I'll try to remember to let you know when it is available.

 

My guess is that Earl presented this in C# because .Net is the future. But
this can be done in VB and Windows Scripting Host. Use the WSH files
collection and then set a ModelDoc2 reference to the current file. Open the
file in SW, make your changes and use ModelDoc2.Save and .Close. Repeat for
each file.

Hope this helps.

Tony

 

Everything listed can be done w/ standard VBA macro. No need for
compiled code. You will need to branch out a bit from stock macro
template and work w/ DSOfile object to sort through file folders.

Also, VBA does not grant license to use "Common Dialog" for file
open/save control or folder browser control. These has to be accessed
via Windows API calls.

 

I am not much of a coder, I pretty much hack and paste what I need from
other macros that I could not create on my own. So does anyone have some
example code I can use.

I really want to take a API course but our local resellers do not seem
to have the people or inclination to have this course. Any on line
courses that anyone knows of so that I can go out on my own and just
start coding without annoying everyone? I have a little VBA under my
belt so I am hoping there is enough base there to work on.

Ben

 

You have the API code for that?(the File-Open routine usually called by
the Common-Dialog Control)? That would be awesome.

For the original poster, yes, standard VB will do what you're wanting.
I've already written code that will parse a directory for a quick
batch-print. Let me know what you intend to do to the drawings once
you have opened them.

 

<http://www.mentalis.org/index2.shtml>

API calls to get components not directly licensed.
Perfectly legit.

 

There's a macro at http://www.nhcad.com/sw_macros/ called BATCH
OPEN.SWB that will open all the files in a specified directory (one at
a time), perform a function, then save and close. The code is setup to
open parts and change their density, but it can easily be modified to
open assemblies and drawings.

Ken

 

Crossed fingers that I can get this to work... So far I had to remove
the "_" from the code in sections like this to get no syntax errors.

Set modelDoc = swApp.OpenDoc2 (Response, _

swDocPart, readOnly, viewOnly, _

silent, returnVal)
this becomes

" Set modelDoc = swApp.OpenDoc2 (Response, swDocPart, readOnly,
viewOnly, silent, returnVal) "

But nothing seems to be happening, no files open and close on the SW
screen. Here is what I have done so far with the code

1. Changed the working directory in this -Const workDir = "c:\jj\sldworks\"

2. Changed the file type to open in this - Const swDocType = ".SLDPRT"
to .SLDDRW

3. Added my code to the function section

Part.SetUserPreferenceIntegerValue swUnitsLinear, swINCHES
Part.SetUserPreferenceIntegerValue swUnitsLinearDecimalDisplay, swFRACTION
Part.SetUserPreferenceIntegerValue swUnitsLinearFractionDenominator, 16
Part.SetUserPreferenceToggle swUnitsLinearRoundToNearestFraction, True
Part.SetUserPreferenceIntegerValue swUnitsAngularDecimalPlaces, 0


But still nouthing????? What am I missing here? Unfortunately this will
even not run as the original code to change densities with the syntax
corrections as mentied above and set to a local directory> I wonder if
this is a machine setting I am missing in running macros?

Below my name is the entire code I have sorry such a long post but those
out there that like puzzles feel free to dissect this and let me know
what has been done wrong. Guess I could email the original coder "Joe
Jones" if he does not view this forum.


Ben

**********************************************************

'

' batch open.swb - macro recorded on 01/14/00 by

' Joe Jones

' New Hampshire CAD www.nhcad.com

'

' This program will do a batch OPEN / CHANGE DENSITY / SAVE / CLOSE

' to all part files ".SLDPRT" found in the working directory.

' With some simple modifications it could be used to batch plot

' or set a host of other user defined values.

'

' to run this program

' 1) start solidworks - do not open any part files

' 2) edit this macro to use the correct working direcotry

' (see "workDir" below)

' 3) run the macro

' ***************************************************************

Dim swApp As Object

Dim ModelDoc As Object

Dim ReturnVal As Long

Dim Response As String

Dim DocName As String

Dim Success As Boolean

Dim DocType As String





' *********** YOU MAY HAVE TO CHANGE THIS ***********

' change the following constant to target a directory

Const workDir = "C:\New Folder"



' *********** YOU MAY HAVE TO CHANGE THIS ***********

' change the following constant to target a type of file

Const swDocType = ".SLDPRT" ' I am only want to open part files





' the following constants are used in the OpenDoc2() function

Const swDocNONE = 0

Const swDocPART = 1

Const swDocASSEMBLY = 2

Const swDocDRAWING = 3



Const readOnly = 0 ' 0-false 1-true

Const viewOnly = 0 ' 0-false 1-true

Const silent = 1 ' 0-false 1-true





' the following constants are used in the

' SetUserPreferenceDoubleValue() function

Const swDetailingNoteFontHeight = 0

Const swDetailingDimFontHeight = 1

Const swSTLDeviation = 2

Const swSTLAngleTolerance = 3

Const swSpinBoxMetricLengthIncrement = 4

Const swSpinBoxEnglishLengthIncrement = 5

Const swSpinBoxAngleIncrement = 6

Const swMaterialPropertyDensity = 7





' start of main program

Sub main()



Set swApp = CreateObject("SldWorks.Application")

ChDir (workDir)

Response = Dir(workDir)



Do Until Response = ""

' see if filename ends with .SLDPRT

If Right(Response, 7) = swDocType Then



' open the SolidWorks part file

Set ModelDoc = swApp.OpenDoc2(Response, swDocPART,
readOnly, viewOnly, silent, ReturnVal)



' add your own code here to do

' whatever you want to the part file

Success =
ModelDoc.SetUserPreferenceDoubleValue(swMaterialPropertyDensity, 2699)
' kg/(cu meter)



' close the part

DoEvents

DocName = ModelDoc.GetTitle

ReturnVal = ModelDoc.Save2(silent)

swApp.CloseDoc DocName

Set ModelDoc = Nothing

End If

' get the next filename

Response = Dir

Loop

Set swApp = Nothing



End Sub

 

I found an example in my own work of the open file Common Dialog via
Windows API. Since then I acquired full VB6 and stopped doing this,
but it's there for your hacking pleasure.

<http://www.esoxrepublic.com/freeware>, in the "Copy Custom Info" macro.

 

Thanks - I downloaded the "mdlCommonDialog" module, and I have all the
functions loaded into VBA, but I need a little help - what do I used to
set hWndOwner?

For example, given the function:

Public Function ShowColor(hWndOwner As Long, Optional nFlags As Long)
As Long

, how would I call that function (setting hWndOwner to what???). I
understand the nFlags, but hWndOwner is a bit outside my realm of
programming.

Thanks

 

Ben,

1. Original working directory "c:\jj\sldworks\" . Your working
directory "C:\New Folder". Notice you're missing a backslash (\) at the
end.
2. Changed the file type to open ".SLDPRT". This might be a case
sensitive problem.
Replace:
If Right(Response, 7) = swDocType Then
With
If Ucase(Right(Response, 7)) = Ucase(swDocType) Then

Ken

 

Ken

Thanks! you have helped alot, this missing '/' was one of the problems.

But...When running the original macro the density of the part does not
change? It does however cycle through the files and re-saves them

Also My drawing macro does not work, doesn't open save and close the
drawings. Will this effect anything:

Set ModelDoc = swApp.OpenDoc2(Response, swDocPART, readOnly, viewOnly,
silent, ReturnVal)

Note the 'swDocPART', should I change this to 'swDocDRAWING'?

 

Ok further to my last
I seem to be able to get my drawing opening to work now but on the first
file open I get "Run time error 91" Object variable or with block
variable not set. which the debugger takes me to this line in the code.

Success = ModelDoc.SetUserPreferenceDoubleValue(7, 2699)
' kg/(cu meter)

After this I have
Part.SetUserPreferenceIntegerValue swUnitsLinear, swINCHES
Part.SetUserPreferenceIntegerValue swUnitsLinearDecimalDisplay, swFRACTION
Part.SetUserPreferenceIntegerValue swUnitsLinearFractionDenominator, 16
Part.SetUserPreferenceToggle swUnitsLinearRoundToNearestFraction, True
Part.SetUserPreferenceIntegerValue swUnitsAngularDecimalPlaces, 0

to reset the drawing units.

Ben

Sorry bout the crash course in code you guys seem to be giving me.

 

Ben,

Just delete this line:
Success = ModelDoc.SetUserPreferenceDoubleValue(7, 2699) ' kg/(cu
meter)
Set ModelDoc = swApp.OpenDoc2(Response, swDocPART, readOnly, viewOnly,
silent, ReturnVal)
Note the 'swDocPART', should I change this to 'swDocDRAWING'?
<<<
Yes you need to change it.
Part.SetUserPreferenceIntegerValue swUnitsLinear, swINCHES
Part.SetUserPreferenceIntegerValue swUnitsLinearDecimalDisplay,
swFRACTION
Part.SetUserPreferenceIntegerValue swUnitsLinearFractionDenominator, 16

Part.SetUserPreferenceToggle swUnitsLinearRoundToNearestFraction, True
Part.SetUserPreferenceIntegerValue swUnitsAngularDecimalPlaces, 0
<<<
Replace all of the "Part." with "ModelDoc."

Ken

 

Thanks!

Now the macro cycles through all the drawings but the units do not
change? Actually any time I run my version of the macro and the original
version of the macro it cycles through the documents like it should but
it does not make any changes to the file... Any idea why?

Again you have been a ton of help Ken thank you! I have learned a lot.

Ben

 

Start a new macro. Delete all of the default stuff that is in the
macro. Paste the code below into the macro. Save the macro. Close the
macro. Run the macro.

If it doesn't work I have no idea what to tell you.
Ken

'**********************************************************
'
' batch open.swb - macro recorded on 01/14/00 by
' Joe Jones
' New Hampshire CAD www.nhcad.com
'
' This program will do a batch OPEN / CHANGE DENSITY / SAVE / CLOSE
' to all part files ".SLDPRT" found in the working directory.
' With some simple modifications it could be used to batch plot
' or set a host of other user defined values.
'
' to run this program
' 1) start solidworks - do not open any part files
' 2) edit this macro to use the correct working direcotry
' (see "workDir" below)
' 3) run the macro
' ***************************************************************

Option Explicit
Dim swApp As Object
Dim ModelDoc As Object
Dim ReturnVal As Long
Dim Response As String
Dim DocName As String
Dim Success As Boolean
Dim DocType As String
Dim swDocTypeLong As Long

' *********** YOU MAY HAVE TO CHANGE THIS ***********
' change the following constant to target a directory
Const workDir = "C:\New Folder\"
' *********** YOU MAY HAVE TO CHANGE THIS ***********
' change the following constant to target a type of file
Const swDocType = ".SLDDRW" ' I am only want to open part files
' the following constants are used in the OpenDoc2() function
'Const swDocNONE = 0
'Const swDocPART = 1
'Const swDocASSEMBLY = 2
'Const swDocDRAWING = 3
Const readOnly = 0 ' 0-false 1-true
Const viewOnly = 0 ' 0-false 1-true
Const silent = 1 ' 0-false 1-true
' the following constants are used in the
' SetUserPreferenceDoubleValue() function

' start of main program
Sub main()
Set swApp = CreateObject("SldWorks.Application")
ChDir (workDir)
Response = Dir(workDir)
Do Until Response = ""
' see if filename ends with .SLDPRT
If Right(Response, 7) = swDocType Then

' open the SolidWorks file
If UCase$(swDocType) = ".SLDPRT" Then
swDocTypeLong = swDocPART
ElseIf UCase$(swDocType) = ".SLDASM" Then
swDocTypeLong = swDocASSEMBLY
ElseIf UCase$(swDocType) = ".SLDDRW" Then
swDocTypeLong = swDocDRAWING
Else
Stop 'Error Occured
End If
Set ModelDoc = swApp.OpenDoc2(Response, swDocTypeLong,
readOnly, viewOnly, silent, ReturnVal)

' add your own code here to do
' whatever you want to the part file
ModelDoc.SetUserPreferenceIntegerValue swUnitsLinear,
swINCHES
ModelDoc.SetUserPreferenceIntegerValue
swUnitsLinearDecimalDisplay, swFRACTION
ModelDoc.SetUserPreferenceIntegerValue
swUnitsLinearFractionDenominator, 16
ModelDoc.SetUserPreferenceToggle
swUnitsLinearRoundToNearestFraction, True
ModelDoc.SetUserPreferenceIntegerValue
swUnitsAngularDecimalPlaces, 0

' close the part
DoEvents

DocName = ModelDoc.GetTitle
ReturnVal = ModelDoc.Save2(silent)

swApp.CloseDoc DocName
Set ModelDoc = Nothing

End If
' get the next filename

Response = Dir
Loop

Set swApp = Nothing
End Sub