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
SolidworksApi macros