Custom Property Rename

I need some major help. Has anyone ever heard of a macro/program that
will read a custom property that I specify off of a Solidworks 2005
part, then rename that file to the custom property value. And be able
to do this in some kind of batch mode, not just individual files. If
no one can help me, I am going to have a huge amount of work in front
of me. I know you guys can do it. Rescue me! lol

 

There is no rename for custom properties. Any macro would have to add
one and delete the other.

If none of the properties are config-specific, it can all be done
without opening files. Is this the case?

I'll see what I can do, but no promises. Probably something that does
everything in a single directory.

 

I recently helped a company with a macro that saves a pdf of all
drawing files in a specified folder and uses a couple custom properties
for the saved name. I think you should be able to modify it to do what
you need.

Kent
www.KentContract.com

Here's the macro...

Dim swApp As Object
Dim swModel As Object
Dim ret As Boolean
Dim dummyRet As Long
Dim longstatus As Long
Dim errorFilePath As String
Dim nErrors As Long
Dim nWarnings As Long
Dim nI As Integer, nDirectory As Integer
Dim sFilename As String
Dim result
Dim temp As String
Dim destination As String
Dim note, view As Object
Dim PartNo As String
Dim Revision As String
Dim ModelName As String
Dim DocType As Integer
Dim ParentModel As Object
Dim ParentOpened As Boolean
Dim IsNextView As Boolean

Sub main()

'----------------------
TASKWORKDIR = "C:\Work In Progress\" & $$$TASK_FILE_PATHNAME$$$ & "\"
TASKFILEPATHNAME = "C:\Work In Progress\" & $$$TASK_FILE_PATHNAME$$$ &
"\"


' Create logging file....
Open "C:\Work In Progress\PDF Conversion Log\PDF Conversion Log.txt"
For Append As #1
Print #1, "----" & Now() & "----"

' Determine type of document
longstatus = 0

sFilename = Dir(TASKFILEPATHNAME)
Do While sFilename <> ""
result = UCase(sFilename) Like "*.SLDDRW"
result1 = UCase(sFilename) Like "~*"
If result And Not result1 Then
sfullFilePath = TASKFILEPATHNAME & sFilename
Set swApp = CreateObject("SldWorks.Application")

swApp.SetCurrentWorkingDirectory (TASKWORKDIR)

Set swModel = swApp.OpenDoc6(sfullFilePath, 3, 1, "", dummyRet,
longstatus)

Set swModel = swApp.ActivateDoc(sFilename)

Set view = swModel.GetFirstView
Set view = view.GetNextView

If view Is Nothing Then
IsNextView = False
Else
IsNextView = True
End If

If IsNextView And Not swModel Is Nothing Then
ModelName = LCase(view.GetReferencedModelName)

If InStr(1, ModelName, ".sldprt") > 0 Then
DocType = 1 'swDocPART
Else
DocType = 2 'swDocASSEMBLY
End If

Set ParentModel = swApp.OpenDoc6(ModelName, DocType, 0, "",
nErrors, nWarnings) 'swOpenDocOptions_Silent

If Not ParentModel Is Nothing Then
PartNo = Trim(ParentModel.CustomInfo2("", "PartNo"))
Revision = Trim(ParentModel.CustomInfo2("",
"Revision"))
swApp.CloseDoc ModelName
ParentOpened = True
Else
ParentOpened = False
End If

If Val(PartNo) = 0 Or Len(Revision) = 0 Or Len(Revision) >
3 Or Not ParentOpened Then
print #1, sFileName & " " & $$$TASK_FILE_PATHNAME$$$
If Val(PartNo) = 0 Then
Print #1, "invalid part number: " & PartNo
End If

If Len(Revision) = 0 Or Len(Revision) > 3 Then
Print #1, "invalid revision: " & Revision
End If

If Not ParentOpened Then
Print #1, "could not open parent file: " &
ModelName
End If

Print #1, ""
Print #1, ""
Else
bRet = swModel.SaveAs4("C:\Documents and
Settings\Tomas\Desktop\Shared\Work In Progress\PBS PDF files\" & PartNo
& "_" & Revision & "_K.PDF", swSaveAsCurrentVersion,
swSaveAsOptions_Silent, nErrors, nWarnings)
End If
Else
print #1, sFileName & " " & $$$TASK_FILE_PATHNAME$$$
Print #1, "couldn't access next view"
Print #1, ""
Print #1, ""
End If
swApp.CloseDoc sFilename
End If

PartNo = ""
Revision = ""
sFilename = Dir
Loop

' close the log file....
Close #1

' Kill it all
If Not swModel Is Nothing Then
swApp.ExitApp
End If

End Sub

 

I think it would be faster to read the custom props and rename the files to
the custom prop value without opening them in SW it can be done I would put
it together for say $50 just tell the boss how many hours you will save you
doing it manually. I think it should run a bit quicker than using SW to do
it. Plus you won't have to remove the origionals.

Contact me @
Corey

Scheich

at

Hotmail

you know how to finish it.

Corey

 

Tick don't work too hard I think you misread the post he wants to rename the
file not the property.

Corey

 

Aw, crud! Just finished.
<http://www.esoxrepublic.com/PropRename/>
I might be able to pull of the file rename. Stand by!

 

ATTENTION:

Renaming files will disrupt assemblies/components and external
references!

 

You can rename the documents in Pdmworks and the references are kept intact.

 

Got it! Same URL as before: <http://www.esoxrepublic.com/PropRename/>
(caps sensitive)

I included source code for anyone interested. Note that you will need
references to DSOfile and Scripting Runtime libraries (included in
compiled install package)

Notes:
-looks at one folder at a time. Does not go through subfolders (this
will cost you)
-changes select SW file type names to that of selected property
-does not open file in SW
-because files do not open in SW, property cross-references are not
evaluated (i.e. $PRP:"propname"). A warning will come up and ask if
you want to proceed each time this is encountered.

 

I really appreciate the program. If I can get it to work I will name
my first born after you. The problem that I am having is when I run
the setup program. I get a message that says

Setup cannot continue because some system files are out of date on your
system. Click OK if you would like setup to update these files for you
now. You will need to restart Windows before you can run setup again.
Click cancel to exit setup without updating system files.

I am not sure what it is needing. I restarted and I get the same
message. Solidworks Office 2005 sp0.1 is installed on system. What am
I doing wrong? Any advice?

 

hmm... don't know what to say. Sounds more like a Windows issue than a
SW issue.

What version of windows are you running? Got the latest SP for your
Windows install?

Is antivirus OFF?

I did provide source code at the same web location if you care to make
a macro out of this. You will need to add references to MS scripting
runtime and DSOfile for the macro to work, though.

 

Ouch! Hit my head on the low part of the learning curve again.

It is a problem with the setup package, Microsoft has this well
documented. I compiled a new setup package and it is available at
<http://www.esoxrepublic.com/PropRename/>. New setup file is
"RenameFileToProp-Mk2.zip". Keep me posted. I want to be sure I get
this working.

Microsoft documentation at <http://support.microsoft.com/kb/831491>,
for the API-curious.

 

It worked like a charm. You have no idea how much this will help me
out. You should keep developing this, and maybe make it your program
include sub folders. That would really be the best. I know you said
it would cost, but why would the company I work for pay for it, when
they can just pay me to sit here and go file by file. They are too
cheap for that. I'll tell everyone about http://www.esoxrepublic.com
since you helped me. Maybe get you a few more hits. Thanks again.

 

Hey Tick,

Here is an example of recursing sub-directories. I created it because our
IT was complaining about how our Hard Drive usage had "Dramatically
Increased" I wanted to prove that most of it was just the new version of
SW. It shouldn't be that much work to modify for your app here. This was
written to run from VBA.

Sub Folders()
'This code in it's entirety created by Corey Scheich
'on April 25, 2003
Dim Folder As Object
Dim FolderContents As Object
Dim File1

Set WorkBK = Excel.ThisWorkbook
Set Sht = ThisWorkbook.ActiveSheet


Set FileSystem = CreateObject("Scripting.FileSystemObject")
MySearch "G:"


End Sub






Sub MySearch(FolderName As String)
'This code in it's entirety created by Corey Scheich
'on April 25, 2003
Dim Folder As Object
Dim FolderFiles As Object
Dim SubFolder As Object
Dim SubFolder1
Dim File1


Set Folder = FileSystem.GetFolder(FolderName)
Set FolderFiles = Folder.Files
Set SubFolder = Folder.SubFolders

Count = 1

For Each File1 In FolderContents

Set File = FileSystem.GetFile(File1.Path)

CreateDate = File.datecreated

If CreateDate > "1/1/2003" Then

FileSize = File.Size / 1024 'convert to KB
Sht.Range("A" + CStr(Count)).Value = File1.Path
Sht.Range("B" + CStr(Count)).Value = FileSize
Count = Count + 1

End If
Next
For Each SubFolder1 In SubFolder
MySearch SubFolder1.Path
Next


End Sub

Corey

 

Thanks. I've done recursive subdirectory stuff before. Just more work
than I was going to do for free, is all.
The source code is posted if you care to "roll your own".

 

Nah I want to get paid too.