Date custom property macro, is this possible?

Below is a macro I found on the newsgroup that inserts the current
date in the "Date" custom property.

1. Is there a way to automatically run this when a NEW drawing is
open?

2. If the above is not possible, could an "If/Then" statement be used
to say If "Date Created"= 1/11/11" then do the command. This woud
allow the default template to have the "Date Created" custom property
defaulted to 1/11/11, and if someone opens a existing drawing with a
date 2/02/04, they macro wont change that date.


Dim DrawingDoc As Object
Dim swApp As Object
Dim Part As Object
Dim Gtol As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Sub main()
Set swApp = CreateObject("SldWorks.Application")
Set DrawingDoc = swApp.ActiveDoc
retval = DrawingDoc.DeleteCustomInfo("Date completed")
retval = DrawingDoc.AddCustomInfo("Date completed", "Date",
Str(Date))
DrawingDoc.EditRebuild
Sendkeys "%FP~",1
End Sub

 

Yeah it is possible. We are doing just that.
I coppied most of this from a post i had made in august to answer a similar
question.

1) Ok Create a macro in the same directory as the "swp" that inputs your
info Name it "Events.swp"

2) Paste this code in the Module1 or Events1 whatever the module is

Sub main()
Set ThisLibrary.swApp = Application.SldWorks
End Sub

3) then Paste this code in Solidworks Objects/ThisLibrary

Public WithEvents swApp As SldWorks.SldWorks

Private Function swApp_FileNewNotify2(ByVal newDoc As Object, ByVal DocType
'insert code you want to run when user creates a new file
End Function

This code will watch for events until stop is hit in the VBA editor. It can
be restarted simply by playing main.

then to invoke the code upon startup paste this line in the shortcuts to
SolidWorks.exe after "C:\Program Files\SolidWorks\sldworks.exe"
put

/m "Some path to your macro\Events.swp"

If your Macro files are on the network all you have to do is paste this into
the shortcuts on each machine.

Regards,
Corey

 

Look into inserting the macro into the feature manager itself. This is a
function that was added into sw2003 though I do not believe many have used
it. As a side plug, Mike Wilsons website was a good example of using this
"Macro Feature". Basically what it does is you create a macro and insert it
into the model, everytime you hit rebuild it runs the macro. His website
is: http://www.mikejwilson.com/solidworks/solidworks_files.htm

The catch is, you wont find much info about it in the solidworks help
file.... BUT if you go into the API help file and search for macro feature
you'll find a wealth on info.

 

mecaleca, did you find an answer to #2? Ive been looking for a way to
insert the current date easily in a drawing. That macro seems like it
will work, but it doesnt stop somebody from overwriting a good date.

As for the event macro, wouldnt that change the date everytime a
drawing is open? You dont want that to happen, correct? If you do,
then just use Solidworks built in command, SW-Short Date.

 

No it only runs when you hit file new or the new file button. I wrote mine
to only change the date when the new file is a drawing file.

Note that the event is swApp_FileNewNotify2 the event that would run upon a
opening a new document is
swApp_FileOpenNotify2 or swApp_ActiveDocChangeNotify would run when
switching between documents.

 

Dale,
An exe would probably be better since a macro for some reason cannot
watch for the Destroy notification of the application so you are unable to
run anything upon closing SW.

Corey

 

The only reason I wanted it was to keep an excel doc open until sw shut down
and then close it when exiting SW.

 

Corey, i cant get that macro to work. I get this error, Compile
Error: Procedure declaration does not match description of event or
procedure having the same name"

Then is has "Private Function swApp_FileNewNotify2(ByVal newDoc As
Object, ByVal DocType" highlighted.

 

Corey, i cant get that macro to work. I get this error, Compile
Error: Procedure declaration does not match description of event or
procedure having the same name"

Then is has "Private Function swApp_FileNewNotify2(ByVal newDoc As
Object, ByVal DocType" highlighted.[/QUOTE]

It should have a Parentheses at the end My bad.
Private Function swApp_FileNewNotify2(ByVal newDoc As Object, ByVal DocType)

If you still can't get it to work I will send you an example.

 

That didnt work either. I actually typed that missing parenthesis,
and the command i posted is what I got.

Can you post the full macro file so I can download?

 

I tried posting to a few NGs and SW wouldn't post it and Yahoo wouldn't keep
it on the server. I don't know were else to post it. E-mail me if you want
it direct.

Here is my code ThisLibrary for now

'
****************************************************************************
**
' Created on 08/28/03 by Corey Scheich
'
****************************************************************************
**
Option Compare Text
Dim VBEapp As VBE
Public WithEvents swApp As SldWorks.SldWorks
Public WithEvents swPart As SldWorks.PartDoc
Public WithEvents swAssy As SldWorks.AssemblyDoc
Public WithEvents swDrw As SldWorks.DrawingDoc
Public ActvDoc As SldWorks.ModelDoc2



'Ensure that we always have the active doc watched
Private Function swApp_ActiveDocChangeNotify() As Long
Dim DocType As String
Set ActvDoc = swApp.ActiveDoc
Select Case ActvDoc.GetType
Case 1
Set swPart = swApp.ActiveDoc
Case 2
Set swAssy = swApp.ActiveDoc
Case 3
Set swDrw = swApp.ActiveDoc
End Select
End Function
'Ensure that we always have the active doc watched
Private Function swApp_ActiveModelDocChangeNotify() As Long
Dim DocType As String
Set ActvDoc = swApp.ActiveDoc
Select Case ActvDoc.GetType
Case 1
Set swPart = swApp.ActiveDoc
Case 2
Set swAssy = swApp.ActiveDoc
Case 3
Set swDrw = swApp.ActiveDoc
End Select
End Function

'This will run every time a new document is created
Private Function swApp_FileNewNotify2(ByVal newDoc As Object, ByVal DocType
As Long, ByVal templateName As String) As Long

'Is the new document a Drawing
If DocType = 3 Then '3 it the enumerated value for a drawing document

Dim ProjectPath As String
Dim SplitPath As Variant
Set VBEapp = Application.VBE
'What is the path of this project
ProjectPath = swApp.GetCurrentMacroPathName
'Strip the path
SplitPath = Split(ProjectPath, "\", -1, vbTextCompare)
ProjectPath = Left(ProjectPath, Len(ProjectPath) -
Len(SplitPath(UBound(SplitPath))))
'Run Date.swp (you could run what ever date macro you have or add it
to this macro)
swApp.RunMacro ProjectPath & "Date.swp", "Module1", "Main"
End If

End Function


'If the configuration is changed in this assembly zoom to fit
Private Function swAssy_ActiveConfigChangePostNotify() As Long

ActvDoc.ViewZoomtofit2

End Function



'This is an unfinished attempt to update a Drawings description property
'with the description of the Model named in the custom property view upon
saving
'This would ensure that every drawing would have an accurate description
'in the file open dialogue.

'Private Function swDrw_FileSaveNotify(ByVal fileName As String) As Long
' Dim ThisSheet As SldWorks.Sheet
' Dim ThisView As SldWorks.view
' Dim ThisViewName As String
' Dim ModelName As String
' Dim ThisModel As SldWorks.ModelDoc2
' Dim Description As String
' Dim CustomInfoNms() As String
' Dim Count As Long
'
' Set ThisSheet = swDrw.GetCurrentSheet
' ThisViewName = ThisSheet.CustomPropertyView
' Set ThisView = swDrw.GetFirstView
'
' Do While Not ThisView Is Nothing
' If ThisViewName = ThisView.Name Then
' Exit Do
' End If
' Set ThisView = ThisView.GetNextView
' Loop
'
' If ThisView Is Nothing Then
' Set ThisView = swDrw.GetFirstView
' End If
' ModelName = ThisView.GetReferencedModelName
' Set ThisModel = swApp.GetAddInObject(ModelName)
'
' CustomInfoNms = ThisModel.GetCustomInfoNames2("")
' Count = 0
' Description = ""
' ThisModel.cust
' For Count = 0 To UBound(CustomInfoNms)
' If CustomInfoNms(Count) = "description" Then
' Description = ThisModel.GetCustomInfoValue("",
CustomInfoNms(Count))
' Exit For
' End If
' Next
'
' If Description = "" Then Exit Function
' If Not ActvDoc.GetTitle = fileName Then MsgBox "Caution Active doc is:
" & ActvDoc.GetTitle
' CustomInfoNms = ActvDoc.GetCustomInfoNames2("")
' Count = 0
'
' For Count = 0 To UBound(CustomInfoNms)
' If CustomInfoNms(Count) = "description" Then
' retval = ActvDoc.DeleteCustomInfo2("", CustomInfoNms(Count))
' End If
' Next
' retval = ActvDoc.AddCustomInfo3("", "Description", 30, Description)
'End Function

'If the configuration is changed in this Part zoom to fit
Private Function swPart_ActiveConfigChangePostNotify() As Long

ActvDoc.ViewZoomtofit2

End Function