Hi techies,

I can't get following code working.

Only when I manually click on cutlist properties and click OK the values from the cutlist properties are transferred to the custom properties.

I need this to work because of interfacing with Keytech.

Regards,

Frans

Option Explicit

' VA_Startup_Module

Public MyClass As New Events_Class

Sub main()
    MyClass.MonitorSolidWorks
End Sub

Option Explicit

' Events_Class

Dim WithEvents swApp As SldWorks.SldWorks
Dim WithEvents MyPart As SldWorks.PartDoc
Dim WithEvents MyAssembly As SldWorks.AssemblyDoc
Dim WithEvents MyDrawing As SldWorks.DrawingDoc

Public Sub MonitorSolidWorks()
    Set swApp = Application.SldWorks
End Sub

Private Function MyPart_FileSaveAsNotify2(ByVal FileName As String) As Long
    Dim result As Long
    result = MsgBox("Click OK to save Part " & FileName & ".", vbOKCancel + vbQuestion)
    If result = vbCancel Then
        MyPart_FileSaveAsNotify2 = 1
    End If
End Function

Private Function swApp_CommandOpenPreNotify(ByVal Command As Long, ByVal UserCommand As Long) As Long
  If Command = 2 And UserCommand = 0 Then
    If swApp.ActiveDoc.GetType = swDocPART Then
      VA_UpdateProperties
    End If
  End If
End Function

Public Sub VA_UpdateProperties()

  Dim swModelDoc               As SldWorks.ModelDoc2
  Dim swSelectionMgr           As SldWorks.SelectionMgr
  Dim MyFeature                As SldWorks.Feature
  Dim swCustomPropertyManager  As SldWorks.CustomPropertyManager
  Dim MyBodyFolder             As BodyFolder
  Dim MyFeatureManager         As Object
 
  Dim names                    As Variant
  Dim name                     As Variant
  Dim textexp                  As String
  Dim evalval                  As String
  Dim sName                    As String
 
  Set MyPart = swApp.ActiveDoc

  MyPart.ForceRebuild3 True
       
  Set MyBodyFolder = Nothing
  Set MyFeature = MyPart.FirstFeature
  Set MyFeatureManager = MyPart.FeatureManager
 
  Do While Not MyFeature Is Nothing
    If MyFeature.GetTypeName2 = "SolidBodyFolder" Then
      Set MyBodyFolder = MyFeature.GetSpecificFeature2
      If MyBodyFolder.UpdateCutList Then
         Exit Do
      End If
    End If
    Set MyFeature = MyFeature.GetNextFeature
  Loop

  Set MyFeature = MyPart.FirstFeature
  Do While Not MyFeature Is Nothing
    If MyFeature.GetTypeName2 = "CutListFolder" Then
      Set MyBodyFolder = MyFeature.GetSpecificFeature2
      MyBodyFolder.SetAutomaticCutList True
      Exit Do
    End If
    Set MyFeature = MyFeature.GetNextFeature
  Loop
 
  MyFeatureManager.UpdateFeatureTree

  If MyFeature Is Nothing Then
    swApp.SendMsgToUser "ERROR in VA_UpdateProperties: Cutlist not found"
    Exit Sub
  End If
  
  Set swModelDoc = Application.SldWorks.ActiveDoc
  If swModelDoc Is Nothing Then
    swApp.SendMsgToUser "ERROR in VA_UpdateProperties: No active document"
    Exit Sub
  End If
 
  Set swSelectionMgr = swModelDoc.SelectionManager
  If swSelectionMgr Is Nothing Then
    swApp.SendMsgToUser "ERROR in VA_UpdateProperties: Problem with determining SelectionManager"
    Exit Sub
  End If

  Set swCustomPropertyManager = MyFeature.CustomPropertyManager
  If swCustomPropertyManager Is Nothing Then
    swApp.SendMsgToUser "ERROR in VA_UpdateProperties: Problem with determining PropertyManager"
    Exit Sub
  End If
 
  names = swCustomPropertyManager.GetNames
 
  For Each name In names
    'Get Cutlist-item
    swCustomPropertyManager.Get2 name, textexp, evalval
    sName = Replace("PDB_" & Trim(name), " ", "_")
    'First try to delete custom prop
    swModelDoc.DeleteCustomInfo2 "", sName
    'Then add custom prop
    swModelDoc.AddCustomInfo3 "", sName, swCustomInfoText, evalval
    If sName = "PDB_Bounding_Box_Length" Then
      Debug.Print
      Debug.Print sName, swCustomInfoText, evalval
    End If
  Next name
  swApp.SendMsgToUser "INFO in VA_UpdateProperties:: Custom properties updated"
 
End Sub