Utilisation document manager

Bonjour,

Je commence à utiliser document manager pour récupérer mes propriétés solidworks sur mon fichier excel.
Je fais fasse à 2 problèmes actuellement.
J’aimerai avoir certaines propriété en écriture littérale autre que le nom de la propriété
exemple ici, j’aimerai avoir une valeur en kg ou g, pareil pour les propriété type « file name » etc
image

Et j’aimerai également avoir un menu déroulant sans pour autant écraser ma formule
Exemple : Je pourrais mettre à jours un indice de révision avec un menu déroulant. Je sais qu’il est possible avec la commande substitute de faire des copier coller pour mettre à jours les valeurs mais c’est tout.
image

Si quelqu’un à des suggestions, je suis preneur.

Il faut récupérer la valeur évaluée de la propriété pas la valeur de la propriété

2 Likes

Bonjour,

Merci pour votre réponse, avez vous plus de précisions s’il vous plait de comment procéder ?

Merci.

Poste ton code (Sans la clé, bien sûr) ou bien la partie du code concerné.
Perso je ne connais pas le document manager mais l’erreur de valeur évaluée ou valeur est la même dans l’API SW. En fonction de ton code on avisera.

'**********************
'Copyright(C) 2022 Xarial Pty Limited
'Reference: Excel macro to manage custom properties in SOLIDWORKS files
'License: License
'**********************

Const SW_DM_KEY As String = « KEY »

Sub main()
End Sub

Function ConnectToDm() As SwDocumentMgr.SwDMApplication

Dim swDmClassFactory As SwDocumentMgr.swDmClassFactory
Dim swDmApp As SwDocumentMgr.SwDMApplication

Set swDmClassFactory = CreateObject("SwDocumentMgr.SwDMClassFactory")
    
If Not swDmClassFactory Is Nothing Then
    Set swDmApp = swDmClassFactory.GetApplication(SW_DM_KEY)
    Set ConnectToDm = swDmApp
Else
    Err.Raise vbError, "", "Document Manager SDK is not installed"
End If

End Function

Function OpenDocument(swDmApp As SwDocumentMgr.SwDMApplication, path As String, readOnly As Boolean) As SwDocumentMgr.SwDMDocument10

Dim ext As String
ext = LCase(Right(path, Len(path) - InStrRev(path, ".")))

Dim docType As SwDmDocumentType

Select Case ext
    Case "sldlfp"
        docType = swDmDocumentPart
    Case "sldprt"
        docType = swDmDocumentPart
    Case "sldasm"
        docType = swDmDocumentAssembly
    Case "slddrw"
        docType = swDmDocumentDrawing
    Case Else
        Err.Raise vbError, "", "Unsupported file type: " & ext
End Select

Dim swDmDoc As SwDocumentMgr.SwDMDocument10
Dim openDocErr As SwDmDocumentOpenError
Set swDmDoc = swDmApp.GetDocument(path, docType, readOnly, openDocErr)

If swDmDoc Is Nothing Then
    Err.Raise vbError, "", "Failed to open document: '" & path & "'. Error Code: " & openDocErr
End If

Set OpenDocument = swDmDoc

End Function

Public Function GETSWPRP(fileName As String, prpNames As Variant, Optional confName As String = «  ») As Variant

Dim swDmApp As SwDocumentMgr.SwDMApplication
Dim swDmDoc As SwDocumentMgr.SwDMDocument10

try_:
On Error GoTo catch_

Dim vNames As Variant
        
If TypeName(prpNames) = "Range" Then
    vNames = RangeToArray(prpNames)
Else
    vNames = Array(CStr(prpNames))
End If

Set swDmApp = ConnectToDm()
Set swDmDoc = OpenDocument(swDmApp, fileName, True)

Dim res() As String
Dim i As Integer
ReDim res(UBound(vNames))

Dim prpType As SwDmCustomInfoType

If confName = "" Then
    For i = 0 To UBound(vNames)
        res(i) = swDmDoc.GetCustomProperty(CStr(vNames(i)), prpType)
    Next
Else
    Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
    Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
    If Not swDmConf Is Nothing Then
        For i = 0 To UBound(vNames)
            res(i) = swDmConf.GetCustomProperty(CStr(vNames(i)), prpType)
        Next
    Else
        Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
    End If
End If

GETSWPRP = res

GoTo finally_

catch_:
Debug.Print Err.Description
Err.Raise Err.Number, Err.Source, Err.Description
finally_:
If Not swDmDoc Is Nothing Then
swDmDoc.CloseDoc
End If

End Function

Public Function SETSWPRP(fileName As String, prpNames As Variant, prpVals As Variant, Optional confName As String = «  »)

Dim swDmApp As SwDocumentMgr.SwDMApplication
Dim swDmDoc As SwDocumentMgr.SwDMDocument10

try_:
On Error GoTo catch_

If TypeName(prpNames) <> TypeName(prpVals) Then
    Err.Raise vbError, "", "Property name and value must be of the same type, e.g. either range or cell"
End If

Dim vNames As Variant
Dim vVals As Variant
    
If TypeName(prpNames) = "Range" Then
    
    vNames = RangeToArray(prpNames)
    
    vVals = RangeToArray(prpVals)
    
    If UBound(vNames) <> UBound(vVals) Then
        Err.Raise vbError, "", "Number of cells in the name and value are not equal"
    End If
Else
    vNames = Array(CStr(prpNames))
    vVals = Array(CStr(prpVals))
End If

Set swDmApp = ConnectToDm()
Set swDmDoc = OpenDocument(swDmApp, fileName, False)

Dim i As Integer

If confName = "" Then
    For i = 0 To UBound(vNames)
        swDmDoc.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
        swDmDoc.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
    Next
Else
    Dim swDmConf As SwDocumentMgr.SwDMConfiguration10
    Set swDmConf = swDmDoc.ConfigurationManager.GetConfigurationByName(confName)
    
    If Not swDmConf Is Nothing Then
        For i = 0 To UBound(vNames)
            swDmConf.AddCustomProperty CStr(vNames(i)), swDmCustomInfoText, CStr(vVals(i))
            swDmConf.SetCustomProperty CStr(vNames(i)), CStr(vVals(i))
        Next
    Else
        Err.Raise vbError, "", "Failed to get configuration '" & confName & "' from '" & fileName & "'"
    End If
End If

swDmDoc.Save

SETSWPRP = "OK"

GoTo finally_

catch_:
Debug.Print Err.Description
Err.Raise Err.Number, Err.Source, Err.Description
finally_:
If Not swDmDoc Is Nothing Then
swDmDoc.CloseDoc
End If

End Function

Private Function RangeToArray(vRange As Variant) As Variant

If TypeName(vRange) = "Range" Then
    Dim excelRange As Range
    Set excelRange = vRange
    
    Dim i As Integer
    
    Dim valsArr() As String
    ReDim valsArr(excelRange.Cells.Count - 1)
    
    i = 0
    
    For Each cell In excelRange.Cells
        valsArr(i) = cell.Value
        i = i + 1
    Next
    
    RangeToArray = valsArr
    
Else
    Err.Raise vbError, "", "Value is not a Range"
End If

End Function

Désolé je ne connais pas bien document manager et je ne trouve donc pas la réponse. Par contre pour les autres il pense que le sujet est résolu puisque tu m’a choisit comme meilleures réponse donc peu de chance d’avoir d’autre réponse sur ce sujet.

1 Like

Bonjour
J’utilise pas cet documentmanager, mais j’ai peut-être une Piste, donc après avoir crée cette propriété masse, reconstruit et enregistres la pièce,

Si ça fonctionne toujours pas, il y’a cette notes dans votre référence


Peut-être pas possible avec les fonctions utilisées !
Avec (GetMassProperties Method (ISwDMConfiguration)) c’est possible

La fonction qui pose problème c’est GETSWPRP et plus particulièrement si je me trompe pas:
swDmConf.GetCustomProperty
Voir pour la remplacer par :
GetAllCustomPropertyNamesAndValues Method (ISwDMConfiguration4)
Voir ici les caractéristiques:
https://help.solidworks.com/2021/english/api/swdocmgrapi/SolidWorks.Interop.swdocumentmgr~SolidWorks.Interop.swdocumentmgr.ISwDMConfiguration4~GetAllCustomPropertyNamesAndValues.html
ou sur la capture ou j’ai surligné la partie pour la valeur évaluée: