1 Reply Latest reply on Jul 15, 2014 3:57 AM by Deepak Gupta

    Drawing Title Block - adding created by and date for the model, and drawn by and date

    Sanya Shmidt

      Hello guys,


      Can someone tell me what would be the easiest way to fill out automatically the following fields on the title block?



      DRAWN BY     DATE


      In our company engineers create parts, and drafters do the drawings on a different machines.


      May be there is an easier way of doing that. What I have so far is a Macro that reads windows user login name and creates a property Author. It is automatically detecting if model is open or the drawing.

      I guess for the DRAWN DATE I can use $PRP:"SW-Short Date" in the sheet format. But what about the CREATED DATE (when the model was created)?

      sw drawnby.PNG

      ' Alex Shmidt (C)2014

      ' For PSI/PPPI


      Sub main()

      ' Define variable used to hold the SldWorks object

      Dim swApp As Object

      Dim wshNet As Object

      Dim swModel As SldWorks.ModelDoc2

      Dim swPart As SldWorks.PartDoc

      Dim sMatName As String

      Dim sMatDB As String

      Dim TopName As String

      Dim retval As String


      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

      Set wshNet = CreateObject("WScript.Network")


      ' Constant enumerators

      Const swDocPART = 1

      Const swDocASSEMBLY = 2

      Const swDocDRAWING = 3


      Set swApp = CreateObject("SldWorks.Application")


      If swModel Is Nothing Then

          ' If no model is currently loaded, then exit

          Exit Sub

      End If


      ' Determine the document type.

      Select Case swModel.GetType

          Case swDocPART

              Set swPart = swModel

              sMatName = swPart.GetMaterialPropertyName2("Default", sMatDB)

              If sMatName = "" Then

                  swApp.SendMsgToUser ("Material is uknown. Please specify material.")

              End If


              swModel.CustomInfo("Material") = sMatName


              ' creating new property if doesn`t exist

              If swModel.CustomInfo2("", "Author") = "" Then

                  retval = swModel.AddCustomInfo3("", "Author", swCustomInfoText, "=")

              End If


              ' get part creator user name

              swModel.CustomInfo("Author") = UCase(Left(wshNet.UserName, 2))


          Case swDocASSEMBLY

              ' do nothing for now


          Case swDocDRAWING

              If swModel.CustomInfo2("", "DrawnBy") = "" Then

                  retval = swModel.AddCustomInfo3("", "DrawnBy", swCustomInfoText, "=")

              End If

              'get user name for drawing DRAWN BY

              swModel.CustomInfo("DrawnBy") = UCase(Left(wshNet.UserName, 2))

      End Select


          Set wshNet = Nothing

          Set swApp = Nothing

      End Sub


      Any help is appreciated.