AnsweredAssumed Answered

Adding both custom/config properties to a prt/asm/drws with a macro

Question asked by Patrick Ellis on Jan 6, 2020
Latest reply on Jan 9, 2020 by Patrick Ellis

Like • Show 0 Likes0
Comment • 9

Help please,

I am trying to have one macro to apply custom and configuration properties to either a part or an assembly or a drawing when you have it open up in SolidWorks. I have started on it but can't get it to add to all configurations that the part or assembly has in it. I would appreciate all the help I can get. Any in sight on a solution?

Objectives

1. add to the custom properties (parts, assemblies, & drawings)

2. add to the configuration properties per configuration. (applies to all configurations)(parts & assemblies)

3. add to the drawing custom properties.

4. I need it to noticed which file I am in. (part/assembly/drawing)

Here is my code below as of now. I have this one only looking at the part or assembly and not the drawing.

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.GetActiveConfiguration.CustomPropertyManager

If swModel.GetType <> 3 Then
    If swModel.GetPathName <> "" Then
        ModelName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

        swModel.AddCustomInfo2 "Material", swCustomInfoText, Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
        swModel.AddCustomInfo2 "Weight", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
        swModel.AddCustomInfo2 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)

        swCustPropMgr.Add3 "Material", swCustomInfoText, Chr(34) & "SW-Material@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
        swCustPropMgr.Add3 "Weight", swCustomInfoText, Chr(34) & "SW-MASS@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
        swCustPropMgr.Add3 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
    Else
    swModel.Save
    End If

End If

End Sub

Deepak Gupta Jan 9, 2020 10:44 AM

Correct Answer

Hi Patrick, try the attached macro. You would have to add/edit the property name as required.

See the reply in context

No one else had this question

Outcomes

Artem Taturevych Jan 6, 2020 5:47 PM

Hi Patrick,

Please take a look at this thread: Fundamentals: Custom Properties Automation

There is a detailed guide on all custom properties automation and several examples. You can directly go to the 'Write Custom Properties' section and there is an 'Write All Properties' example. You just need to exclude the part where it writes to the cut lists and leave general and config specific properties code block,

Thanks,

Artem

Actions

Patrick Ellis @ Artem Taturevych on Jan 6, 2020 6:16 PM

Artem,

I can't tell but will this go thru each configuration and add the properties? I am not a programmer by the way.

My objective is for parts and assemblies and drawings for one macro. I do have selected properties to add to each.

Const PRP_NAME As String = "ApprovedDate"

Dim swApp As SldWorks.SldWorks

Sub main()

Set swApp = Application.SldWorks

Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc

If Not swModel Is Nothing Then

Dim curDate As Date
curDate = Now

Dim dateFormat As String
dateFormat = Format(curDate, "YYYY-MM-dd")

SetGeneralProperty swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
SetConfigurationSpecificProperty swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
Else
MsgBox "Please open model"
End If

End Sub

Sub SetGeneralProperty(model As SldWorks.ModelDoc2, prpName As String, prpVal As String, prpType As swCustomInfoType_e)

SetProperty model.Extension.CustomPropertyManager(""), prpName, prpVal, prpType

End Sub

Sub SetConfigurationSpecificProperty(model As SldWorks.ModelDoc2, prpName As String, prpVal As String, prpType As swCustomInfoType_e)

Dim vNames As Variant
vNames = model.GetConfigurationNames()

Dim i As Integer

For i = 0 To UBound(vNames)

Dim confName As String
confName = vNames(i)

SetProperty model.Extension.CustomPropertyManager(confName), prpName, prpVal, prpType

Next

End Sub

Sub SetProperty(custPrpMgr As SldWorks.CustomPropertyManager, prpName As String, prpVal As String, Optional prpType As swCustomInfoType_e = swCustomInfoType_e.swCustomInfoText)

Dim res As Long
res = custPrpMgr.Add3(prpName, prpType, prpVal, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue)

If res <> swCustomInfoAddResult_e.swCustomInfoAddResult_AddedOrChanged Then
Err.Raise vbError, "", "Failed to set custom property. Error code: " & res
End If

End Sub

Actions

Artem Taturevych @ Patrick Ellis on Jan 6, 2020 9:01 PM

Yes, it will. Just use something like below

SetGeneralProperty swModel, "Material", Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34), swCustomInfoType_e.swCustomInfoText
SetConfigurationSpecificProperty swModel, "Material", Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34), swCustomInfoType_e.swCustomInfoText

And repeat the above lines for every property and value you want

Actions

Patrick Ellis Jan 7, 2020 10:04 AM

Artem,

I tried your suggestion and it lock up on me here is what I have and it works but will not loop on the other configurations. Any ideas?

Also it will not work on Assemblies or drawings.

Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.GetActiveConfiguration.CustomPropertyManager

    If swModel.GetType <> 3 Then
        If swModel.GetPathName <> "" Then
           ModelName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

            swModel.AddCustomInfo2 "Material", swCustomInfoText, Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
            swModel.AddCustomInfo2 "Weight", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
            swModel.AddCustomInfo2 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)

            swCustPropMgr.Add3 "Material", swCustomInfoText, Chr(34) & "SW-Material@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Weight", swCustomInfoText, Chr(34) & "SW-MASS@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Path Length", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Alt_Matl", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Matl_Size_Specs", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Matl_Conditions", swCustomInfoText, "", swCustomPropertyReplaceValue

         Else
            swModel.Save
        End If

    End If

End Sub

Actions

Artem Taturevych @ Patrick Ellis on Jan 7, 2020 3:06 PM

These code lines need to be placed in the macro I have referred to, not in your macro. Then it will loop through confs. I would recommend to firstly run that macro as is and then modify.

Actions

Deepak Gupta @ Patrick Ellis on Jan 9, 2020 10:44 AM

Hi Patrick, try the attached macro. You would have to add/edit the property name as required.

Attachments

Add Model and Drawing Properties.SWP.zip10.1 KB

Actions

Patrick Ellis @ Deepak Gupta on Jan 9, 2020 11:27 AM

Deepak,

Is there a way that we can split the properties between the part and assembly? We have two properties that only need to be in the part and not the assembly.

Material = part only

Path Length = part only

How would you suggest the macro would noticed the difference? Between part level or the assembly level

Actions

Deepak Gupta @ Patrick Ellis on Jan 9, 2020 11:48 AM

Patrick Ellis wrote:

Deepak,

Is there a way that we can split the properties between the part and assembly? We have two properties that only need to be in the part and not the assembly.
Material = part only
Path Length = part only

How would you suggest the macro would noticed the difference? Between part level or the assembly level

Actions

Patrick Ellis @ Deepak Gupta on Jan 9, 2020 12:11 PM

It works perfectly thank you Deepak you are awesome!!!!!!

Actions

9 Replies

Artem Taturevych Jan 6, 2020 5:47 PM
Mark Correct
Correct Answer
Hi Patrick,

Please take a look at this thread: Fundamentals: Custom Properties Automation

There is a detailed guide on all custom properties automation and several examples. You can directly go to the 'Write Custom Properties' section and there is an 'Write All Properties' example. You just need to exclude the part where it writes to the cut lists and leave general and config specific properties code block,

Thanks,
Artem
Like • Show 0 Likes0
Actions
- Patrick Ellis @ Artem Taturevych on Jan 6, 2020 6:16 PM
  Mark Correct
  Correct Answer
  Artem,
  
  I can't tell but will this go thru each configuration and add the properties? I am not a programmer by the way.
  
  My objective is for parts and assemblies and drawings for one macro. I do have selected properties to add to each.
  
  Const PRP_NAME As String = "ApprovedDate"
  
  Dim swApp As SldWorks.SldWorks
  
  Sub main()
  
  Set swApp = Application.SldWorks
  
  Dim swModel As SldWorks.ModelDoc2
  Set swModel = swApp.ActiveDoc
  
  If Not swModel Is Nothing Then
  
  Dim curDate As Date
  curDate = Now
  
  Dim dateFormat As String
  dateFormat = Format(curDate, "YYYY-MM-dd")
  
  SetGeneralProperty swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
  SetConfigurationSpecificProperty swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
  swModel, PRP_NAME, dateFormat, swCustomInfoType_e.swCustomInfoDate
  Else
  MsgBox "Please open model"
  End If
  
  End Sub
  
  Sub SetGeneralProperty(model As SldWorks.ModelDoc2, prpName As String, prpVal As String, prpType As swCustomInfoType_e)
  
  SetProperty model.Extension.CustomPropertyManager(""), prpName, prpVal, prpType
  
  End Sub
  
  Sub SetConfigurationSpecificProperty(model As SldWorks.ModelDoc2, prpName As String, prpVal As String, prpType As swCustomInfoType_e)
  
  Dim vNames As Variant
  vNames = model.GetConfigurationNames()
  
  Dim i As Integer
  
  For i = 0 To UBound(vNames)
  
  Dim confName As String
  confName = vNames(i)
  
  SetProperty model.Extension.CustomPropertyManager(confName), prpName, prpVal, prpType
  
  Next
  
  End Sub
  
  Sub SetProperty(custPrpMgr As SldWorks.CustomPropertyManager, prpName As String, prpVal As String, Optional prpType As swCustomInfoType_e = swCustomInfoType_e.swCustomInfoText)
  
  Dim res As Long
  res = custPrpMgr.Add3(prpName, prpType, prpVal, swCustomPropertyAddOption_e.swCustomPropertyReplaceValue)
  
  If res <> swCustomInfoAddResult_e.swCustomInfoAddResult_AddedOrChanged Then
  Err.Raise vbError, "", "Failed to set custom property. Error code: " & res
  End If
  
  End Sub
  Like • Show 0 Likes0
  Actions
  - Artem Taturevych @ Patrick Ellis on Jan 6, 2020 9:01 PM
    Mark Correct
    Correct Answer
    Yes, it will. Just use something like below
    
    SetGeneralProperty swModel, "Material", Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34), swCustomInfoType_e.swCustomInfoText
    SetConfigurationSpecificProperty swModel, "Material", Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34), swCustomInfoType_e.swCustomInfoText
    
    And repeat the above lines for every property and value you want
    Like • Show 1 Like1
    Actions
Patrick Ellis Jan 7, 2020 10:04 AM
Mark Correct
Correct Answer
Artem,
I tried your suggestion and it lock up on me here is what I have and it works but will not loop on the other configurations. Any ideas?
Also it will not work on Assemblies or drawings.

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swCustPropMgr = swModel.GetActiveConfiguration.CustomPropertyManager

    If swModel.GetType <> 3 Then
        If swModel.GetPathName <> "" Then
           ModelName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

            swModel.AddCustomInfo2 "Material", swCustomInfoText, Chr(34) & "SW-Material" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
            swModel.AddCustomInfo2 "Weight", swCustomInfoText, Chr(34) & "SW-Mass" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)
            swModel.AddCustomInfo2 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea" & "@" & swModel.GetTitle & ".SLDPRT" & Chr(34)

            swCustPropMgr.Add3 "Material", swCustomInfoText, Chr(34) & "SW-Material@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Weight", swCustomInfoText, Chr(34) & "SW-MASS@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Surface Area", swCustomInfoText, Chr(34) & "SW-SurfaceArea@@Default@" & ModelName & Chr(34), swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Path Length", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Alt_Matl", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Matl_Size_Specs", swCustomInfoText, "", swCustomPropertyReplaceValue
            swCustPropMgr.Add3 "Matl_Conditions", swCustomInfoText, "", swCustomPropertyReplaceValue

         Else
            swModel.Save
        End If

    End If

End Sub
Like • Show 0 Likes0
Actions
- Artem Taturevych @ Patrick Ellis on Jan 7, 2020 3:06 PM
  Mark Correct
  Correct Answer
  These code lines need to be placed in the macro I have referred to, not in your macro. Then it will loop through confs. I would recommend to firstly run that macro as is and then modify.
  Like • Show 0 Likes0
  Actions
- Deepak Gupta @ Patrick Ellis on Jan 9, 2020 10:44 AM
  Unmark Correct
  Correct Answer
  Hi Patrick, try the attached macro. You would have to add/edit the property name as required.
  Attachments
  - Add Model and Drawing Properties.SWP.zip10.1 KB
  Like • Show 0 Likes0
  Actions
  - Patrick Ellis @ Deepak Gupta on Jan 9, 2020 11:27 AM
    Mark Correct
    Correct Answer
    Deepak,
    
    Is there a way that we can split the properties between the part and assembly? We have two properties that only need to be in the part and not the assembly.
    Material = part only
    Path Length = part only
    
    How would you suggest the macro would noticed the difference? Between part level or the assembly level
    Like • Show 0 Likes0
    Actions
    - Deepak Gupta @ Patrick Ellis on Jan 9, 2020 11:48 AM
      Mark Correct
      Correct Answer
      Patrick Ellis wrote:
      
      Deepak,
      
      Is there a way that we can split the properties between the part and assembly? We have two properties that only need to be in the part and not the assembly.
      Material = part only
      Path Length = part only
      
      How would you suggest the macro would noticed the difference? Between part level or the assembly level
      Like • Show 1 Like1
      Actions
      - Patrick Ellis @ Deepak Gupta on Jan 9, 2020 12:11 PM
        Mark Correct
        Correct Answer
        It works perfectly thank you Deepak you are awesome!!!!!!
        Like • Show 0 Likes0
        Actions

Adding both custom/config properties to a prt/asm/drws with a macro

Outcomes

Attachments

Related Content

Recommended Content