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

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

Outcomes