OK, below is the macro to create a macro feature. There are 4 constants you will want to change to match your needs:
- PROP_NAME – the name of custom property that will be added to the drawing/template
- PROP_EMPTY_VALUE – the property value when there is no PDM version or no drawing views
- VAULT_NAME – the name of the PDM vault
- MACRO_FEAT_NAME – the feature name that will appear in the feature tree
How To Use It
You can open either your drawing template or individual drawings and and then run the macro. It will check to see if the macro feature has already been added to the file and exit if it has. Otherwise it will add the macro feature. The macro code gets embedded in the file, so if you run the macro in your drawing template and save it, any future drawings made from the template will have the macro feature in them. Other users do not need to have the macro code, unless they want to add the macro feature to individual existing drawings.
What it does
On every rebuild of the drawing, the file version (of the model in the first drawing view on the first sheet) will be retrieved from PDM and this value will be stored in custom property PROP_NAME which you can link to a note.
Limitations
It’s a simple macro feature intended to show what’s possible. As such, if you have multiple models in a single drawing, it’s not going to work correctly.
Dim swApp As SldWorks.SldWorks
Dim mDoc As ModelDoc2
Dim featMgr As FeatureManager
Dim macroFeat As Feature
Dim mExt As ModelDocExtension
Dim propMgr As CustomPropertyManager
Dim dDoc As DrawingDoc
Dim dwgSheetView As View
Dim firstModelView As View
Dim refModel As ModelDoc2
Dim vault As EdmVault5
Dim parentFolder As IEdmFolder5
Dim file As IEdmFile5
Const PROP_NAME = "CURRENT_VERSION"
Const PROP_EMPTY_VALUE = "-"
Const VAULT_NAME = "_DEVELOPMENT"
Const MACRO_FEAT_NAME = "VersionTracker"
Sub main()
On Error GoTo CleanUp:
Set swApp = Application.SldWorks
Set mDoc = swApp.ActiveDoc
If mDoc.GetType <> swDocumentTypes_e.swDocDRAWING Then
Exit Sub
End If
Set featMgr = mDoc.FeatureManager
If macroFeatureExists() Then
Exit Sub
End If
Dim macroFile As String
Dim methods(8) As String
Dim pathname As String
Dim options As Long
macroFile = swApp.GetCurrentMacroPathName
methods(0) = macroFile 'Filename
methods(1) = "VersionTracker1" 'Module
methods(2) = "swmRebuild" 'Regen function
methods(3) = macroFile 'Filename
methods(4) = "VersionTracker1" 'Module
methods(5) = "swmEdit" 'Edit function
methods(6) = macroFile 'Filename
methods(7) = "VersionTracker1" 'Module
methods(8) = "swmSecurity" 'Security function
pathname = swApp.GetCurrentMacroPathFolder
options = swMacroFeatureOptions_e.swMacroFeatureByDefault + swMacroFeatureEmbedMacroFile
Set macroFeat = featMgr.InsertMacroFeature3(MACRO_FEAT_NAME, "", (methods), Empty, Empty, Empty, Nothing, Nothing, Nothing, Empty, options)
CleanUp:
clearRefs
End Sub
Function macroFeatureExists() As Boolean
On Error GoTo CleanUp
Dim vFeatures As Variant
vFeatures = featMgr.GetFeatures(False)
Dim nextFeat As Feature
For i = LBound(vFeatures) To UBound(vFeatures)
Set nextFeat = vFeatures(i)
If nextFeat.GetTypeName2 = "MacroFeature" Then
Dim featData As MacroFeatureData
Set featData = nextFeat.GetDefinition
If featData.GetBaseName = MACRO_FEAT_NAME Then
macroFeatureExists = True
Exit Function
End If
End If
Next i
macroFeatureExists = False
Exit Function
CleanUp:
clearRefs
End Function
Function swmRebuild(app As Variant, part As Variant, feat As Variant) As Variant
On Error GoTo CleanUp
Set mDoc = part
Set dDoc = mDoc
Set mExt = mDoc.Extension
Set propMgr = mExt.CustomPropertyManager("")
Dim val As String
Dim resolvedVal As String
Dim wasResolved As Boolean
'Add the property if it doesn't exist
If propMgr.Get5(PROP_NAME, False, val, resolvedVal, wasResolved) = swCustomInfoGetResult_NotPresent Then
propMgr.Add3 PROP_NAME, swCustomInfoType_e.swCustomInfoText, PROP_EMPTY_VALUE, swCustomPropertyAddOption_e.swCustomPropertyOnlyIfNew
End If
Set dwgSheetView = dDoc.GetFirstView
Set firstModelView = dwgSheetView.GetNextView
If firstModelView Is Nothing Then
propMgr.Set2 PROP_NAME, PROP_EMPTY_VALUE
Rebuild = True
clearRefs
Exit Function
End If
Set refModel = firstModelView.ReferencedDocument
If refModel Is Nothing Then
Rebuild = True
clearRefs
Exit Function
End If
Set vault = New EdmVault5
vault.LoginAuto VAULT_NAME, 0
Set file = vault.GetFileFromPath(refModel.GetPathName(), parentFolder)
If file Is Nothing Then 'Not in vault
Rebuild = True
clearRefs
Exit Function
End If
propMgr.Get5 PROP_NAME, False, val, resolvedVal, wasResolved
If resolvedVal <> Str$(file.CurrentVersion) Then
propMgr.Set2 PROP_NAME, file.CurrentVersion
End If
Rebuild = True
clearRefs
Exit Function
CleanUp:
clearRefs
End Function
Function swmEdit(app As Variant, part As Variant, feat As Variant) As Variant
Edit = False
End Function
Function swmSecurity(app As Variant, part As Variant, feat As Variant) As Variant
Security = swMacroFeatureSecurityOptions_e.swMacroFeatureSecurityByDefault
End Function
Sub clearRefs()
If Not mDoc Is Nothing Then Set mDoc = Nothing
If Not featMgr Is Nothing Then Set featMgr = Nothing
If Not macroFeat Is Nothing Then Set macroFeat = Nothing
If Not mExt Is Nothing Then Set mExt = Nothing
If Not propMgr Is Nothing Then Set propMgr = Nothing
If Not dDoc Is Nothing Then Set dDoc = Nothing
If Not dwgSheetView Is Nothing Then Set dwgSheetView = Nothing
If Not firstModelView Is Nothing Then Set firstModelView = Nothing
If Not refModel Is Nothing Then Set refModel = Nothing
If Not vault Is Nothing Then Set vault = Nothing
If Not parentFolder Is Nothing Then Set parentFolder = Nothing
If Not file Is Nothing Then Set file = Nothing
End Sub