Macro to populate custom properties

[Immow]

Hi all,

I have a macro to populate custom properties of SW file.

There are two things I need to be added and was hoping someone could help me (my VBA knoledge is very low).

1) Remove all exsisting custom properties
2) Get the filename so that Material and Weight are properley set.
"SW-Material@Part1.SLDPRT"

Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc

Dim MyProp(1, 20) As String

'Property names
MyProp(0, 0) = "PartNo"
MyProp(0, 1) = "Title"
MyProp(0, 2) = "Production"
MyProp(0, 3) = "Description"
MyProp(0, 4) = "Remarks"
MyProp(0, 5) = "CheckedBy"
MyProp(0, 6) = "CheckDate"
MyProp(0, 7) = "Amount"
MyProp(0, 8) = "L"
MyProp(0, 9) = "W / d"
MyProp(0, 10) = "H / t"
MyProp(0, 11) = "Prop1"
MyProp(0, 12) = "Prop2"
MyProp(0, 13) = "Prop3"
MyProp(0, 14) = "Below should not be edited"
MyProp(0, 15) = "Revision"
MyProp(0, 16) = "Author"
MyProp(0, 17) = "Mass"
MyProp(0, 18) = "Material"
MyProp(0, 19) = "Project"
MyProp(0, 20) = "Number"


'Property values

MyProp(1, 0) = "[C1_00_00_00]"
MyProp(1, 14) = "Below should not be edited"
MyProp(1, 17) = "SW-Mass@Part1.SLDPRT"
MyProp(1, 18) = "SW-Material@Part1.SLDPRT"



Dim m As Integer

For m = 0 To 20
    retval = Part.AddCustomInfo3("", MyProp(0, m), 30, _
         MyProp(1, m))
Next m

End Sub

 

[TheTick]

http://www.esoxrepublic.com/freeware/DeleteCustInfoDownload.php

Feel free to scalp some script.

Honesty may be the best policy, but insanity is a better defense.

http://www.EsoxRepublic.com

-SolidWorks API VB programming help

 

[Immow]

Thank you for your reply, I edited the macro but its a bit overwhelming.

 

[TheTick]

It's a bit of an antique, circa 2004.