Hello, I am having trouble adding the Description CustomProperty to the sheet name using VBA. Does anyone have a solution?
Bri Guy wrote: Hello, I am having trouble adding the Description CustomProperty to the sheet name using VBA. Does anyone have a solution? THanks
Bri Guy wrote:
#TASK should be able to do it. Have you tried it already?
I just tried it and am recieving an error each time
Unfortunately the following code doesn't work (edited from the Artem Taturevych's post over at Change current sheet name to selected note's text.)
Dim swApp As SldWorks.SldWorksDim swModel As SldWorks.ModelDoc2Dim swDraw As SldWorks.DrawingDocDim swSelMgr As SldWorks.SelectionMgrSub main() Set swApp = Application.SldWorks Set swModel = swApp.ActiveDoc Set swDraw = swModel Set swSelMgr = swModel.SelectionManager Dim swSheet As SldWorks.Sheet Set swSheet = swDraw.GetCurrentSheet() swSheet.SetName "$PRP:" & Chr(34) & "Description" & Chr(34)End Sub
After giving this a try it occurred to me that it probably can't work without a layer of abstraction (if that's the term). The problem appears to be that Sheet Name is also a property. So, you'd have to do something like have a text box somewhere on the sheet that would be linked to the Description and then use the macro to read the text box and rename the sheet based on that value.
if this is the case that would be unfortunate
That shouldn't work, no. You'll need to get the CustomPropertyManager object, the use Get5 to get the value of the Description property:
2016 SOLIDWORKS API Help - CustomPropertyManager Property (IModelDocExtension)
2016 SOLIDWORKS API Help - Get5 Method (ICustomPropertyManager)
Peter Brinkhuis wrote: That shouldn't work, no. You'll need to get the CustomPropertyManager object, the use Get5 to get the value of the Description property:2016 SOLIDWORKS API Help - CustomPropertyManager Property (IModelDocExtension) 2016 SOLIDWORKS API Help - Get5 Method (ICustomPropertyManager)
Peter Brinkhuis wrote:
Nice! I can kludge things together, I'm definitely no programmer.
From a quick look it appears Peter Brinkhuis has provided the missing pieces. Give it a go and let us know if you need some help.
Can you share the code you currently have? What have you tried, which error do you get? That kind of information.
My approach to set the current sheet name as the description would be:
Which step isn't working for you?
Set swApp = Application.SldWorks Set swDraw = swApp.ActiveDoc If swDraw Is Nothing Then MsgBox "Please open the drawing" End End If Dim prpName As String prpName = InputBox("Please specify the custom property name to get the value from") Dim vSheetNames As Variant vSheetNames = swDraw.GetSheetNames Dim i As Integer For i = 0 To UBound(vSheetNames) Dim swSheet As SldWorks.Sheet Set swSheet = swDraw.Sheet(vSheetNames(i)) Dim custPrpViewName As String custPrpViewName = swSheet.CustomPropertyView Dim vViews As Variant vViews = swSheet.GetViews() Dim swCustPrpView As SldWorks.View Set swCustPrpView = Nothing Dim j As Integer For j = 0 To UBound(vViews) Dim swView As SldWorks.View Set swView = vViews(j) If LCase(swView.Name) = LCase(custPrpViewName) Then Set swCustPrpView = swView Exit For End If Next If swCustPrpView Is Nothing Then Set swCustPrpView = vViews(0) End If If Not swCustPrpView Is Nothing Then Dim swRefConfName As String Dim swRefDoc As SldWorks.ModelDoc2 swRefConfName = swCustPrpView.ReferencedConfiguration Set swRefDoc = swCustPrpView.ReferencedDocument If Not swRefDoc Is Nothing Then Dim prpValue As String swRefDoc.Extension.CustomPropertyManager(swRefConfName).Get3 prpName, False, "", prpValue If prpValue = "" Then swRefDoc.Extension.CustomPropertyManager("").Get3 prpName, False, "", prpValue End If If prpValue <> "" Then swSheet.SetName (prpValue) End If
Does that thing even compile? I see two for loops and only one Next. You're missing a few lines at the end as well. Try adding Option Explicit as the first line and define all your variables, then click Debug > Compile to make sure everything is correct.
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager ?
also would this work on multiple pages?
I had a macro that I use to renumber the sheets. I altered it to take the Description property add it to the sheet name and then a number starting at the number you enter in the prompt. This should get you started (thanks again Peter, I learned something new):
Dim swApp As SldWorks.SldWorksDim swModel As SldWorks.ModelDoc2Dim swDraw As SldWorks.DrawingDocDim vSheetName As VariantDim i As IntegerDim bRet As Boolean
Dim swModelDocExt As ModelDocExtensionDim swCustProp As CustomPropertyManagerDim val As StringDim valout As StringDim bool As Boolean
Sub main()Set swApp = Application.SldWorksSet swModel = swApp.ActiveDocSet swDraw = swModelmyNum = InputBox("Enter the first sheet number")If IsNumeric(myNum) = False Then MsgBox ("Enter a numeric value and retry") Exit SubEnd If
Set swModelDocExt = swModel.Extension' Get the custom property dataSet swCustProp = swModelDocExt.CustomPropertyManager("")bool = swCustProp.Get4("Description", False, val, valout)
' Rename the sheets to a dummy nameCall RenameSheets("99999999", val)Call RenameSheets(myNum, val)End Sub
Sub RenameSheets(myName, myProp)vSheetName = swDraw.GetSheetNames For i = 0 To UBound(vSheetName) mynewNum = myName + i bRet = swDraw.ActivateSheet(vSheetName(i)) Dim swSheet As Sheet Set swSheet = swDraw.Sheet(vSheetName(i)) If (swSheet.IsLoaded) Then swSheet.SetName myProp & mynewNum Else Debug.Print (vSheetName(i) & " is not loaded.") End If Next iEnd Sub
awesome thank you for the assist matt
No problem. I hope it works for what you need.
Sorry, but I can't help if you are just pasting code without context. What is your question? What is working, what is not working?
I can't run the code posted above because the end is missing.
Bri, I think here is original macro you are reffering to: Rename SOLIDWORKS drawing sheets with custom properties values
Try this one and let me know if you have any issues or questions.
I'm about to take off and haven't had a chance to look at Artem's link, but even if what I kludged together works, what he's providing is going to be better. He's a real programmer and has put together some great macros and programs. So definitely take a look at it.
Thank you, Matt, your solution will work just fine as well. I just pasted the link, because I believe this is where Bri's original code came from (full version), but it was missing bits and pieces as Peter mentioned:
I hope your weekend was well.
Thank you for the link. I am having an issue with the code, unfortunately. The input box does show up but then I get mismatch error at the line For j = 0 To UBound(vViews) . Not sure why this would be an issue.
Retrieving data ...