Need help with a macro to fill out configuration properties 1

[LFowler]

I am trying to create a macro for solidworks that will pull some information out of the file name and put it in the configuration properties.

So far I can parse the name fine as well as change some of the fields within the properties, but a few of them are giving me some trouble. Mostly the "description" field but the checkbox below that and the BOM options are inconsistent at best. The Part.EditConfiguration3 command doesn't play nice with the description field.

If someone would point me in the right direction, I've attached a picture showing what properties need to be filled in and checked. Thanks.

 

[aer73]

Hi.
I need something like that.
Somebody can help us?
Thanks to all.
Best regards.

 

[LFowler]

Here is my crude macro, it gets the job done:

Dim swConfMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swModel As Object
Dim PartNum As String
Dim PartName As String
Dim dash As Integer
Dim descrip As String
Dim partedit As Boolean
Dim dispstate As Boolean

Sub main()

Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swConfMgr = swModel.ConfigurationManager
Set swConfig = swConfMgr.ActiveConfiguration

'Get part info
'Stores the entire name of the current file
PartName = swModel.GetTitle

'Get part number
dash = InStr(10, PartName, " - ", vbBinaryCompare)
PartNum = Mid(PartName, dash + 3, 6)
descrip = Mid(PartName, 8, dash - 8)
'''''

'Main edit of configuration
InitialConfig = swModel.GetConfigurationNames

partedit = swModel.EditConfiguration3(InitialConfig(0), PartNum, "", PartNum, 10000001)
''''

'Edit description field
swConfig.Description = descrip
'''''

'Rename display state
currentstate = swConfig.GetDisplayStates()
dispstate = swConfig.RenameDisplayState(currentstate(0), PartNum)
'''''
End Sub

You probably will need to edit the way it gets the part number and description for your own use.

 

[aer73]

Many thanks LFowler for share your macro.
I try to work with it and and configure as i want.
Best regards.

 

[EEnd]

Below is the macro that I use. The setBoMPartNumberSource function changes the drop down in the bill of materials section. However its performance is erratic. Sometimes it works, but I frequently have to manually change the selection and rerun the macro. The isToolboxCopiedPart function will not work as pasted here. It requires a key from SW for their document manager.

Eric

Option Explicit
Dim message As String
Dim actionTaken As Boolean
Sub main()

    Dim swApp As SldWorks.SldWorks
    Set swApp = Application.SldWorks
    
    Dim document As SldWorks.ModelDoc2
    Set document = swApp.ActiveDoc
    
    Dim fs As New Scripting.FileSystemObject
    
    message = "Actions Taken in " + fs.GetFileName(document.GetPathName) + ":"
    actionTaken = False
    
    Select Case document.GetType
        Case swDocDRAWING
            setSwDetailingBOMBalloonStyle document
            setSwDetailingBOMUpperText document
            setSwDetailingBOMUpperCustomProperty document

        Case swDocPART, swDocASSEMBLY
            Dim part As SldWorks.PartDoc
            
            setNumberProperty document
            setDescriptionProperty document
            setRevisionProperty document
            setCalloutText document
            setBoMPartNumberSource document
            setAlternativeName document
            
        Case Else
            message = "This macro only works on parts, drawings and assemblies."
            actionTaken = True
    End Select
    
    If (Not actionTaken) Then
        logAction "nothing"
    End If
    
    MsgBox message
End Sub

Sub logAction(msg As String)
    actionTaken = True
    message = message + Chr$(13) + "  " + msg
End Sub

Sub setSwDetailingBOMBalloonStyle(document As SldWorks.ModelDoc2)
    If (document.GetUserPreferenceIntegerValue(swDetailingBOMBalloonStyle) <> swBS_None) Then
        document.SetUserPreferenceIntegerValue swDetailingBOMBalloonStyle, swBS_None
        logAction "Balloon style set to: none"
    End If
End Sub

Sub setSwDetailingBOMUpperText(document As SldWorks.ModelDoc2)
    If (document.GetUserPreferenceIntegerValue(swDetailingBOMUpperText) <> swBalloonTextCustomProperties) Then
        document.SetUserPreferenceIntegerValue swDetailingBOMUpperText, swBalloonTextCustomProperties
        logAction "Upper Balloon Text changed to: Custom Property"
    End If
End Sub

Sub setSwDetailingBOMUpperCustomProperty(document As SldWorks.ModelDoc2)
    If (StrComp(document.GetUserPreferenceStringValue(swDetailingBOMUpperCustomProperty), "Callout Text") <> 0) Then
        document.SetUserPreferenceStringValue swDetailingBOMUpperCustomProperty, "Callout Text"
        logAction "Upper Balloon Text Property changed to: Callout Text"
    End If
End Sub

Sub setCalloutText(document As SldWorks.ModelDoc2)
    Dim calloutText As String
    calloutText = "$PRP:""Description""" + ChrW(10) + "$PRP:""Number""-$PRP:""Revision"""
    
    Dim propertyManager As SldWorks.CustomPropertyManager
    Set propertyManager = document.extension.CustomPropertyManager("")
    
    Dim success As Long
                        
    If (propertyExists(propertyManager, "Callout Text")) Then
        Dim val As String
        Dim evaluatedVal As String
        propertyManager.Get2 "Callout Text", val, evaluatedVal
        
        If (StrComp(val, calloutText) <> 0) Then
            propertyManager.Set "Callout Text", calloutText
            logAction "Callout Text property changed to: " + calloutText
        End If
    Else
        success = propertyManager.Add2("Callout Text", swCustomInfoText, calloutText)
        If (success = 1) Then
            logAction "Callout Text property created and set to: " + calloutText
        End If
    End If
End Sub

Sub setBoMPartNumberSource(document As SldWorks.ModelDoc2)
    Dim cfg As SldWorks.Configuration
    Set cfg = document.ConfigurationManager.ActiveConfiguration
    
    If (cfg.BOMPartNoSource <> swBOMPartNumber_UserSpecified) Then
        cfg.BOMPartNoSource = swBOMPartNumber_UserSpecified
        logAction "BOM PartNo Source changed to: User Specified in configuration: " + cfg.Name
    End If
End Sub

Sub setAlternativeName(document As SldWorks.ModelDoc2)
    Dim cfg As SldWorks.Configuration
    Set cfg = document.ConfigurationManager.ActiveConfiguration
    
    Dim alternativeName As String
    alternativeName = "$PRP:""Number""-$PRP:""Revision"""
    
    If (StrComp(cfg.AlternateName, alternativeName) <> 0) Then
        cfg.AlternateName = alternativeName
        logAction "Alternative Name changed to: " + alternativeName + " in configuration: " + cfg.Name
    End If
End Sub

Sub setNumberProperty(document As SldWorks.ModelDoc2)
    Dim propertyManager As SldWorks.CustomPropertyManager
    Set propertyManager = document.extension.CustomPropertyManager("")
    
    If (Not propertyExists(propertyManager, "Number")) Then
        Dim success As Long
        success = propertyManager.Add2("Number", swCustomInfoText, "")
        If (success = 1) Then
            logAction "Number property created."
        End If
    End If
End Sub

Sub setDescriptionProperty(document As SldWorks.ModelDoc2)
    Dim description As String
    description = "$PRP:""SW-File Name"""
    
    Dim propertyManager As SldWorks.CustomPropertyManager
    Set propertyManager = document.extension.CustomPropertyManager("")
    
    If (propertyExists(propertyManager, "Description")) Then
        Dim val As String
        Dim evaluatedVal As String
        propertyManager.Get2 "Description", val, evaluatedVal
        
        If (((StrComp(val, "") = 0) Or (StrComp(val, " ") = 0)) And (StrComp(description, "") <> 0)) Then
            propertyManager.Set "Description", description
            logAction "Description property set to: " + description
        End If
    Else
        Dim success As Long
        success = propertyManager.Add2("Description", swCustomInfoText, description)
        
        If (success = 1) Then
            If (StrComp(description, "") <> 0) Then
                logAction "Description property created and set to: " + description
            Else
                logAction "Description property created."
            End If
        End If
    End If
End Sub

Sub setRevisionProperty(document As SldWorks.ModelDoc2)
    Dim propertyManager As SldWorks.CustomPropertyManager
    Set propertyManager = document.extension.CustomPropertyManager("")
    
                        
    If (propertyExists(propertyManager, "Revision")) Then
        Dim val As String
        Dim evaluatedVal As String
        propertyManager.Get2 "Description", val, evaluatedVal
      
        If (((StrComp(val, "") = 0) Or (StrComp(val, " ") = 0)) And isToolboxCopiedPart(document)) Then
            propertyManager.Set "Revision", "A"
            logAction "Revision property set to: A"
        End If
    Else
        Dim setToA As Boolean
        setToA = isToolboxCopiedPart(document)
        
        Dim success As Long
        If (setToA) Then
            success = propertyManager.Add2("Revision", swCustomInfoText, "A")
        Else
            success = propertyManager.Add2("Revision", swCustomInfoText, "")
        End If
            
        If (success = 1) Then
            If (setToA) Then
                logAction "Revision property created and set to: A"
            Else
                logAction "Revision property created."
            End If
        End If
    End If
End Sub

Function propertyExists(propertyManager As SldWorks.CustomPropertyManager, propertyName As String) As Boolean
    Dim found As Boolean
    found = False
    
    If (propertyManager.Count > 0) Then
        Dim propertyNames() As String
        propertyNames = propertyManager.GetNames
        
        Dim i As Integer
        For i = LBound(propertyNames) To UBound(propertyNames)
            If StrComp(propertyNames(i), propertyName) = 0 Then
                found = True
                Exit For
            End If
        Next i
    End If

    propertyExists = found
End Function

Function isToolboxCopiedPart(document As SldWorks.ModelDoc2) As Boolean
    Dim result As Boolean
    result = False
    
    If (document.GetType = swDocPART) Then
        Dim classFac As New SwDocumentMgr.SwDMClassFactory
        
        Dim swDocMgr As SwDocumentMgr.SwDMApplication
        Set swDocMgr = classFac.GetApplication("Need your own key here.")
        
        Dim errorCallBack As SwDmDocumentOpenError
        Dim docMgrDocument As SwDMDocument
        Set docMgrDocument = swDocMgr.GetDocument(document.GetPathName, swDmDocumentPart, True, errorCallBack)
        
        result = ((docMgrDocument.toolboxPart And swDmToolboxCopiedPart) > 0)
    End If
    
    isToolboxCopiedPart = result
End Function

 

[aer73]

Thanks to both for this macros.
Best regards.