Preview   |   SOLIDWORKS User Forum

 Get Write Access Via Macro - Multi User Enviorment
Kyle Blough   |  15 days ago
Open in Forum   

All you need is a SOLIDWORKS ID, or a new or existing 3DEXPERIENCE ID.

Hi Folks,

I am working on a master properties macro, and I am running into a limitation of the macro with parts/assemblies that were forgotten to be checked out (PDM Pro). If you forget to check out the part before you run the main macro, there are values that are not saved upon closing the macro and you will have to reenter the values after the part/assembly is check out.

So, my next addition to the macro is to add a check out button to this master properties macro. I have been able to check out the file from Solidworks, but I am running into the issue with the window in Solidworks still says "read only" after check out. My thought to get around this, is to use the multi user environment option and toggle the system property and some how then toggle the get write access command. And this is my hang up. I have been able to do everything but get the get write access command to work. 

I have tired going down the path with SetReadOnly method, but I am hitting Error 438 and not sure how to fix this.  Is this the better route over multi user enviorment?

Here is the Macro I have so far:

Const VAULT_NAME As String = "EBVault"

Dim swApp As SldWorks.SldWorks
Dim swPdmVault As IEdmVault5
Dim check As Boolean
Dim Value As Boolean
'Dim instance As swCommands_e

Sub main()

Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Set swPdmVault = New EdmVault5
swPdmVault.LoginAuto VAULT_NAME, 0
If swPdmVault.IsLoggedIn Then
CheckOutModel swModel, swPdmVault
MsgBox "Please login to vault"
End If
MsgBox "Please open the model"
End If
End Sub

Sub CheckOutModel(model As SldWorks.ModelDoc2, vault As IEdmVault5)

Dim modelPath As String
modelPath = model.GetPathName()
Dim swPdmFile As IEdmFile5
Set swPdmFile = vault.GetFileFromPath(modelPath)
Set swApp = Application.SldWorks

If Not swPdmFile Is Nothing Then
On Error GoTo catch

Dim res As Boolean
Dim swPdmFolder As IEdmFolder5
Set swPdmFolder = vault.GetFolderFromPath(Left(modelPath, InStrRev(modelPath, "\")))

swPdmFile.LockFile swPdmFolder.ID, 0
res = True
GoTo finally
Debug.Print Err.Number & ": "; Err.Description
res = False
GoTo finally
model.ReloadOrReplace Not res, modelPath, Not res

Err.Raise vbError, "", "Specified model doesn't exist in the vault"
End If
Dim instance As IModelDoc2
Dim SetReadOnly As Boolean
'SetReadOnly = False
'Value = instance.SetReadOnlyState(SetReadOnly)
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swCollabEnableMultiUser, True
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swCollabAddShortcutMenuItems, True
End Sub

Thanks for any help!

You are not authorized to view this page No results found! Suggestions: Check spelling, try a different search, or browse topics below.