SW properties display request

Here's an easy way to do it while retaining the power of custom props. Have a macro separate the file name into two separate custom properties. Then you can use the custom props in notes, title block, or whatever.

' ****************************************************************************** ' Separate.swp - macro recorded on 02/07/05 ' ****************************************************************************** Sub main()

Dim swApp As Object Dim Part As Object Dim Title As String, Message As String Dim PartNo As String, Desc As String Dim Separator As Integer Dim bRetval As Boolean Const swCustomInfoText = 30 'from swconst.bas

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc Title = Part.GetTitle

Separator = InStr(1, Title, "-", vbTextCompare) If Separator = 0 Then Separator = InStr(1, Title, "_", vbTextCompare) End If ' Don't do anything if separator is not found If Separator = 0 Then Message = "Unable to separate file name into p/n and desc" MsgBox Message, vbOKOnly, "Error!" Else ' Left part of file name PartNo = Left(Title, Separator - 1) ' Right part of file name Desc = Right(Title, Len(Title) - Separator) ' Check if Windows is set to show extensions. If InStr(1, Title, ".sld", vbTextCompare) > 0 Then ' If so, remove extension. Desc = Left(Desc, Len(Desc) - 7) End If 'MsgBox "PartNo = " & PartNo & " Desc = " & Description ' Write out custom props bRetval = Part.AddCustomInfo3("", "PartNo", swCustomInfoText, PartNo) 'bRetval = True if successful ' Overwrite existing (above will fail if props exist) Part.CustomInfo2("", "PartNo") = PartNo bRetval = Part.AddCustomInfo3("", "Description", swCustomInfoText, Desc) Part.CustomInfo2("", "Description") = Desc End If

End Sub

Or you could do it this way with MicroSoft VBscript regular expressions:

'****************************************************************************** ' Separate.swp - macro recorded on 02/07/05 '****************************************************************************** Sub main()

Dim swApp As Object Dim Part As Object Dim Title As String, Message As String Dim PartNo As String, Desc As String Dim Separator As Integer Dim bRetval As Boolean Dim re, matches, match Const swCustomInfoText = 30 'from swconst.bas

Set swApp = Application.SldWorks Set Part = swApp.ActiveDoc Set re = New RegExp Title = Part.GetTitle

re.IgnoreCase = True re.Pattern = "(\d{6})" Set matches = re.Execute(Title) For Each match In matches PartNo = match.value Next

re.Pattern = "[a-zA-Z ]+" Set matches = re.Execute(Title) For Each match In matches Description = match.value Next

MsgBox "PartNo = " & PartNo & " Desc = " & Description

End Sub

PAUL,

I get a compile error (user defined type not defined) on the line:

Set re = New RegExp

when trying to run this. ideas? Also, is it possible to email this to me directly as a .swp file?

clay

'******************************************************************************

'******************************************************************************

Regular expressions don't really exist in VBA/VB6. You can get them by adding a reference to "Microsoft VBScript Regular Expressions 5.5"

. If you are just running your code once, then this will be OK, but VBA's inability to remember references makes it problematic if you are trying to distribute the macro.

If you use .NET and write either an executable or an add-in, it will be no problem b/c .NET includes regular expressions.

'***************************************************************************

***

'***************************************************************************

***