Open DataCard with a VBA Macro

Hello,

I just wrote a Makro that writes some custom properties of a 3D-Model in a particular way before we export them to our ERP-System. At the End i would like the Makro to open the Datacard with all the relevant infos . Because it´s what every user will do after the makro to check if it worked like supposed to. So why not implement it. I didn’t think it would be so complicated …

Is there an easy way of doing that ? I think the funktion IEdmCardview.ShowWindow ist the one i need, but don´t know how to acces IEdmCardView. Can anyone help me ?

I’m running the Makro directly von Solidworks (2022), I wrote the code in VBA, and we are using SOLIDWORKS PDM 2022-

Here is the Code i have so far:

Sub OpenPDMDocumentCard()
    ' Declare variables
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim pdmVault As IEdmVault5
    Dim pdmFile As IEdmFile5
    Dim pdmFolder As IEdmFolder13
    Dim pdmCard As IEdmCard7
    Dim pdmCardView As IEdmCardView64
    Dim selectionList As Object
    Dim pathFi As String
    Dim pathFo As String
    Dim myExt As String
    Dim pdmCardID As String
    
    ' Get the SOLIDWORKS application
    Set swApp = Application.SldWorks
    
    ' Check if a document is open
    If swApp.ActiveDoc Is Nothing Then
        MsgBox "No document is currently open."
        Exit Sub
    End If
    
    ' Get the active model
    Set swModel = swApp.ActiveDoc
    pathFi = swModel.GetPathName
    Debug.Print pathFi
    pathFo = Left(pathFi, InStrRev(pathFi, "\"))
    Debug.Print pathFo
    myExt = Right(pathFi, Len(pathFi) - InStrRev(pathFi, "."))
    Debug.Print myExt
    ' Get the PDM vault
    Set pdmVault = CreateObject("ConisioLib.EdmVault")
    
    ' Check if the document is managed by PDM
    If pdmVault Is Nothing Then
        MsgBox "The document is not managed by SOLIDWORKS PDM."
        Exit Sub
    End If
    If Not pdmVault.IsLoggedIn Then pdmVault.Login "admin", "nimda", "Drehtainer"
    
    ' Get the PDM file
    
    Set pdmFile = pdmVault.GetFileFromPath(pathFi)
    ' Check if the file is found in the vault
    If pdmFile Is Nothing Then
        MsgBox "The document is not found in the SOLIDWORKS PDM vault."
        Exit Sub
    End If
    
    'Get PDM Folder
    Set pdmFolder = pdmVault.GetFolderFromPath(pathFo)
    ' Get CardID
    pdmCardID = pdmFolder.GetCardID(myExt)
    
    'Get Card
    Set pdmCard = pdmFolder.GetCard(myExt)
    ' Get the card view for the document
    Set pdmCardView = pdmCard.
    pdmCardView.ShowWindow
    ' Check if the card view is available
    If pdmCardView Is Nothing Then
        MsgBox "The document does not have a PDM Data card."
        Exit Sub
    End If
    
    ' Show the card view window
    pdmCardView.ShowWindow True
End Sub

I have been able to get it to show up, but it’s not usable in any way. I’ve looked into implementing the callback interface that’s recommended but that still doesn’t handle clicking, typing, etc. I suspect this may be a limitation of VBA but it’s hard to say without trying this with c# for vb.net.

Module Code:

Option Explicit
Public Const VAULT_NAME As String = "your vault name here"

Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As ModelDoc2
    
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    
    Dim myForm As UserForm1
    Set myForm = New UserForm1
    Debug.Assert Not myForm Is Nothing
    myForm.Setup swModel.GetPathName
    myForm.Show vbModal
End Sub

UserForm1:

Option Explicit

Dim pdmVaultObject As New EdmVault5
Dim pdmVault As IEdmVault10
Dim pdmFile As IEdmFile5
Dim pdmFolder As IEdmFolder5
Dim pdmCardViewParams As EdmCardViewParams
Dim pdmCardView As IEdmCardView63
Dim filePath As String

#If Win64 Then
    Private Declare PtrSafe Function IUnknown_GetWindow Lib _
    "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
#Else
    Private Declare Function IUnknown_GetWindow Lib _
    "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
#End If
 
Public Function GetUserformHwnd(ByVal ufmTarget As MSForms.UserForm) As Long
     IUnknown_GetWindow ufmTarget, VarPtr(GetUserformHwnd)
End Function

Private Sub UserForm_Activate()

    pdmCardView.ShowWindow True
    
End Sub

Public Sub Setup(path As String)
    filePath = path
    
    Set pdmVault = pdmVaultObject
    
    If Not pdmVault.IsLoggedIn Then
        pdmVault.LoginAuto VAULT_NAME, GetUserformHwnd(Me)
    End If
    
    Set pdmFile = pdmVault.GetFileFromPath(filePath, pdmFolder)
    pdmCardViewParams.mlFileID = pdmFile.ID
    pdmCardViewParams.mlFolderID = pdmFolder.ID
    pdmCardViewParams.mlCardID = 0
    pdmCardViewParams.mlX = 0
    pdmCardViewParams.mlY = 0
    pdmCardViewParams.mhParentWindow = GetUserformHwnd(Me)
    pdmCardViewParams.mlEdmCardViewFlags = EdmCardViewFlag.EdmCvf_Normal
    
    Set pdmCardView = pdmVault.CreateCardViewEx2(pdmCardViewParams, Me)
    pdmCardView.SetFocus 0
    pdmCardView.Update EdmCardViewUpdateType.EdmCvut_EnableCtrl
    
    Dim cardWidth As Long
    Dim cardHeight As Long
    
    pdmCardView.GetCardSize cardWidth, cardHeight
    
    Me.width = cardWidth
    Me.height = cardHeight
End Sub
1 Like

Thanks for coming back!