ds-blue-logo
Preview  |  SOLIDWORKS USER FORUM
Use your SOLIDWORKS ID or 3DEXPERIENCE ID to log in.
CKCADsupport Ka-group30/03/2011

I have found some pieces of code here and there, and put together a macro that sets the Mass/Section units, and creates some custom properties.

It works fine (see code below), but so far only for Parts. Is there an easy way to perform a filetype check in the beginning, and make some "ifs" to apply alternative actions to Part vs. Assy? This challenge applies because I'm using one Custom Property that require the filetype extension to work (can for example be "Surface area [cm²]@Part1.SLDPRT").

If the file is a Drawing, I would like to skip the actions, and perhaps be informed by a pop-up message box. My experience with API and macros is very limited. All help will be highly appreciated. Thanks.

Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Dim CusPropMgr As SldWorks.CustomPropertyManager
Dim AddStatus As Long
Dim sValue As String
Dim strFilename As String
Dim strResFilename As String
Dim strModString As String
Dim bolCheck As Boolean
Dim inCount As Integer

Sub main()

Set swApp = Application.SldWorks

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

Set Part = swApp.ActiveDoc

' Set the Unit system to Custom
boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_Custom)

' Get/Check Mass/Section Properties - Length - Unit, if mm
If (Part.Extension.GetUserPreferenceInteger(swUnitsMassPropLength, 0) = 0) Then

' Change to cm
boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, 1) '

Else

' Else keep or set to cm
boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropLength, 0, 1)

End If

' Get/Check Mass/Section Properties - Mass - Unit, if kg
If (Part.Extension.GetUserPreferenceInteger(swUnitsMassPropMass, 0) = 3) Then

' Change to grams
boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, 2) '

Else

' Else keep or set to grams
boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, 2)

End If

Set CusPropMgr = swModel.Extension.CustomPropertyManager("")
   
'Get the File Name of the Part
strFilename = swModel.GetPathName

bolCheck = False
inCount = 1

strResFilename = Left(strFilename, Len(strFilename) - 7)

Do While bolCheck = False
strModString = Right(strResFilename, intCount)
If Left(strModString, 1) = "\" Then
strResFilename = Right(strResFilename, intCount - 1)
bolCheck = True
Else
intCount = intCount + 1
End If
Loop
   
    'Create custom properties if they are missing.
     
    sValue = Chr(34) & "SW-Mass" & Chr(34)
    AddStatus = CusPropMgr.Add2("Weight", swCustomInfoText, sValue)
    SetStatus = CusPropMgr.Set("Weight", sValue)
   
    sValue = "g"
   
    AddStatus = CusPropMgr.Add2("Weight unit", swCustomInfoText, sValue)
    SetStatus = CusPropMgr.Set("Weight unit", sValue)
       
    sValue = Chr(34) & "Surface area [cm²]@" & strResFilename & ".SLDPRT" & Chr(34)
    AddStatus = CusPropMgr.Add2("Surface area [cm²]", swCustomInfoText, sValue)
    SetStatus = CusPropMgr.Set("Surface area [cm²]", sValue)
   
    sValue = "cm²"
    AddStatus = CusPropMgr.Add2("Surface area unit", swCustomInfoText, sValue)
    SetStatus = CusPropMgr.Set("Surface area unit", sValue)
   
    swApp.ActiveDoc.ActiveView.FrameState = 1
   
    swModel.FileSummaryInfo
   
End Sub