Need help with a macro to fill out configuration properties
Need help with a macro to fill out configuration properties
(OP)
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.
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.






RE: Need help with a macro to fill out configuration properties
I need something like that.
Somebody can help us?
Thanks to all.
Best regards.
RE: Need help with a macro to fill out configuration properties
CODE
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.
RE: Need help with a macro to fill out configuration properties
I try to work with it and and configure as i want.
Best regards.
RE: Need help with a macro to fill out configuration properties
Eric
CODE
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
RE: Need help with a macro to fill out configuration properties
Best regards.