Help with autochanging a number in a custom property (Macro)

Can someone help me with the macro below. The macro opens a part, then
changes the "Serial" custom property, then saves the file as "Serial"
and the number in the customer property. I am trying to figure out how
to auto change this number. I have 100 parts to change this note, and
it would be nice to run a macro to auto change the custom property,
then save it as a file with "Serial000001.sldprt, Serial000002.sldprt,
etc etc)



Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.OpenDoc4("serial.SLDPRT", 1, 0, "", longstatus)
Set Part = swApp.ActivateDoc("serial.SLDPRT")
retval = Part.AddCustomInfo3(EmptyStr, "Serial", 30, "0000001")
Part.EditRebuild
Part.SaveAs2 "serial000001.SLDPRT", 0, False, False
swApp.CloseDoc "serial000001.SLDPRT"
End Sub

 

Dim serialcount as long
dim strSerial as string
Dim FileName as string

serialcount = 1

for serialcount = 1 to 10
strserial = format (serialcount, "000000")
filename = "Serial" & strserial & ".sldprt"
msgbox filename
next


Do you want to continue creating coppies of Serial.sldprt

 

I need to make 100 parts, serial # 000001 to #000100

I have a note on a model, that will be etched onto the plate (laser
cut). I need this note to change on every part, then save that part as
serial000001, serial000002, etc etc

 

Yes, i need to autogenerate 100 parts. There is a note on each part
for the serial #. Im trying to make a macro that will open a default
part (serial.sldprt), then change the note (note linked to a custom
propoerty that is changed) then saves the part as
"serial000001.sldprt". This macro would add 1 to the serial# and do
the same for 000002,3,4,5,etc etc.

Any help would be appreciated. Thanks

 

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long
Dim Annotation As Object
Dim Gtol As Object
Dim DatumTag As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object

Sub main()
Dim Errors As Long
Dim Warnings As Long
Dim serialcount as long
Dim strSerial as string
Dim FileName as string

serialcount = 1

for serialcount = 1 to 10

next

Set swApp = Application.SldWorks

Set Part = swApp.OpenDoc4("serial.SLDPRT", 1, 0, "", longstatus)
Set Part = swApp.ActivateDoc("serial.SLDPRT")

for serialcount = 1 to 100
strserial = format (serialcount, "000000")
filename = "Serial" & strserial & ".sldprt"
retval = Part.DeleteCustomInfo2("", "Serial")
retval = Part.AddCustomInfo3(EmptyStr, "Serial", 30, strSerial)
Part.EditRebuild
SaveOpts = swSaveAsOptions_Copy
retval = Part.SaveAs4(filename , 0, SaveOpts, Errors, Warnings)
next

swApp.CloseDoc "serial.SLDPRT"
End Sub

This is written for 2004 and up mostly because of CONST's

Regards,
Corey

 

Thanks Corey, that works great. I have a problem though, I cant seem
to link text in a sketch to a custom property. This seems like a no
brainer. I tried linking it like you would a note, but it doesnt have
the option.
I am using 2003 still, is that a new feature in 2004 or 2005?

 

I believe it is in 2005 I don't think it is available in 2004
I am still on 2004

Corey