Drawing No. Macro

Dim swApp As SldWorks.SldWorks

Sub main()

Dim swModel As ModelDoc2

Dim vComps As Variant

Dim swComp As SldWorks.Component2

Dim swAssy As SldWorks.AssemblyDoc

Dim i As Integer

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

updateProperty swModel

If swModel.GetType = swDocASSEMBLY Then

    Set swAssy = swModel

    vComps = swAssy.GetComponents(False)

    For i = 0 To UBound(vComps)

        Set swComp = vComps(i)

        Set swModel = swComp.GetModelDoc2

        updateProperty swModel

    Next i

End If



End Sub




Function updateProperty(swModel As SldWorks.ModelDoc2) As Boolean

Dim filename As String, ProjectName As String, DrawingNo As String

Dim cpm As CustomPropertyManager



Set cpm = swModel.Extension.CustomPropertyManager("")



'get needed info from model file name

filename = swModel.GetTitle

filename = Replace(Replace(filename, ".sldprt", ""), ".sldasm", "")

ProjectName = val(filename)

If ProjectName = 0 Then



Else

'Add Project Name to custom properties and add text

cpm.Add2 "ProjectNo", swCustomInfoText, " "

cpm.Set "ProjectNo", ProjectName

DrawingNo = Left(filename, 8)

End If



If ProjectName = 0 Then



Else

'Add Number to custom properties and add text

cpm.Add2 "DrawingNo", swCustomInfoText, " "

cpm.Set "DrawingNo", DrawingNo

End If



End Function