26 Replies Latest reply on Jul 31, 2013 3:46 PM by Greg Johnson

    Accessing the drawing number thru VBA

    Jason Wilger

      I am looking to save files as TIF files. I have the macro for that part working, but the macro saves as the model name, not the Dwg No property, which are different. I have changed the macro to match some of the other discussions, but I am just getting errors. Any help would be great. This is the macro I currently have:

       

      Dim longstatus As Long, longwarnings As Long

      Dim Feature As Object

      Dim swSheet As SldWorks.Sheet

      Dim swDraw As SldWorks.DrawingDoc

      Dim bRet As Boolean

      Dim i As Long

      Dim vSheetProps As Variant

      Const swTiffPrintScaleToFit As Long = 28

      Const swTiffScreenOrPrintCapture As Long = 6

      Const swTiffImageType As Long = 7

      Const swTiffCompressionScheme As Long = 8

      Const swTiffPrintDPI As Long = 9

      Const swTiffPrintPaperSize As Long = 10

       

      Sub main()

      Set swApp = Application.SldWorks

      Set swModel = swApp.ActiveDoc

      f = "C:\SOLIDWORKS COMPONENTS\New folder\"

      Debug.Print "PrintScaleToFit        = " + Str(swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swTiffPrintScaleToFit, True))

      Debug.Print "ScreenOrPrintCapture   = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture, 1))

      Debug.Print "allorcurrentsheet      = " + Str(swApp.SetUserPreferenceIntegerValue(swallorcurrentsheet, 1))

      Debug.Print "ImageType              = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffImageType, 0))

      Debug.Print "CompressionScheme      = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffCompressionScheme, 2))

      Debug.Print "PrintDPI               = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintDPI, 200))

      Debug.Print "PrintPaperSize         = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintPaperSize))

       

      file = Dir(f)

          Do While file <> ""

          filen = f + file

          namelength = Len(filen)

          filetype = Mid(filen, (namelength - 5), 7)

          namelength1 = Len(file)

          filename1 = Mid(file, 1, (namelength1 - 7))

          Debug.Print file

          Debug.Print filename1

          lcasefiletype = LCase(filetype)

              If lcasefiletype = "slddrw" Then

                      Set Part = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                      swApp.OpenDoc6 filen, 3, 0, "", longstatus, longwarnings

                      Set swModel = swApp.ActiveDoc

                      Set swDraw = swModel

                              bRet = swDraw.ActivateSheet("Sheet1")

                              Set swSheet = swDraw.GetCurrentSheet

                              vSheetProps = swSheet.GetProperties

          Debug.Print "  TemplateName              = " & swSheet.GetTemplateName

          Debug.Print "  PaperSize                 = " & vSheetProps(0)

          Debug.Print "PrintPaperSize         = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintPaperSize, vSheetProps(0)))

                              Part.SaveAs2 f + filename1 & ".TIF", 0, True, False

                      Set Part = Nothing

                      swApp.CloseDoc f + file

              Else

              End If

       

          file = Dir()

      Loop

      End Sub

        • Re: Accessing the drawing number thru VBA
          Keith Hooks

          You can use ModelDocExtension to get a CustomPropertyManager.  With that, you can access any of the documents properites.  I'm not working in VB, but here's the way I do it in C#.  Just replace Revision with the name of your custom property name.

           

          public static string getDocRevisionProperty(ModelDoc2 swModelDoc)

                  {

                      ModelDocExtension swModelDocExt = default(ModelDocExtension);

                      CustomPropertyManager swCustProp = default(CustomPropertyManager);

                      string val = "";

                      string valout = "";

                      bool status;

           

                      swModelDocExt = swModelDoc.Extension;

           

                      swCustProp = swModelDocExt.get_CustomPropertyManager("");

                      status = swCustProp.Get4("Revision", false, out val, out valout);  //pass the val, valout by reference

           

                      return val;

           

                  }

            • Re: Accessing the drawing number thru VBA
              Jason Wilger

              I need the PRPSHEET:"Dwg No" to be the value accessed. I can get it to work if I use a value in the properties of the drawing, but I need the properties of the assembly / part. I can't seem to get it to accept the syntax for the text previous.

                • Re: Accessing the drawing number thru VBA
                  Greg Johnson

                  Add this code...

                   

                  dim swModelDoc as SldWorks.ModelDoc2

                  Dim swModelDocExt as SldWorks.ModelDocExtension

                  Dim swCustomPropMgr as sldworks.custompropertymanager

                  dim strValOut as String

                  dim strResolvedValOut as String

                   

                  swModelDoc = swDraw

                  swModelDocExt = swModelDoc.Extension

                  swCustomPropMgr = swModelDocExt.CustomPropertyManager("")

                   

                  'this line gets the value of the custom property

                  swCustomPropMgr.get4("Dwg No", False, strValOut, StrResolvedValOut)

                   

                  'strValOut or strResolvedValOut will be the value you need.

                   

                  Greg

                  • Re: Accessing the drawing number thru VBA
                    Keith Hooks

                    Are you trying to access a property of a model contained within the drawing?  In that case, I believe you'll need to get a pointer to the ModelDoc2 for the part/assembly contained in the drawing.  I've done it like this:

                               

                                swDraw as DrawingDoc

                                swPart as ModelDoc2

                                swView as View

                     

                                set swDraw = swModel

                     

                                swView = swDraw.GetFirstView()    //return the sheet

                                swView = swView.GetNextView()   //returns the first view

                                Debug.Print("Selecting a component from a drawing view: " + swView.GetName2());

                     

                                swPart = swView.ReferencedDocument;

                     

                    From there, get the properties directly from the part/assembly model.

                      • Re: Accessing the drawing number thru VBA
                        Keith Hooks

                        Remember that $PRPSHEET refers to the property of a model in a view on the drawing.  I don't believe you can access it directly - you need to first navigate there via my comments above.  Get the sheet, then get the view, then get the model referenced in the view.  Then access that model's properties via ModelDoc2.Extension.

                          • Re: Accessing the drawing number thru VBA
                            Jason Wilger

                            Keith,

                            Thanks for the information. I tried adding your code to my macro, but I get Invalid Syntax errors when I try to run. Maybe this is a C# to VBA transfer problem. If you have any suggestions, that would be great.

                              • Re: Accessing the drawing number thru VBA
                                Greg Johnson

                                Can you post your code as it is written now?

                                • Re: Accessing the drawing number thru VBA
                                  Keith Hooks

                                  I apologize for the poor VBA syntax.  I program in C# primarily, but I took a stab at the VB syntax.  My hope was that you could use it as a template to see what objects are being manipulated.  Good luck.

                                    • Re: Accessing the drawing number thru VBA
                                      Greg Johnson

                                      Jason,

                                       

                                      Put a single quote ' in front of the // in Keith's code. That should comment the unneeded information from those lines. Keith, correct me if I'm wrong but the // is the comment syntax in C#. The line should be...

                                       

                                      set swView = swDraw.GetFirstView() '//return the sheet

                                      set swView = swView.GetNextView() '//returns the first view

                                       

                                      set swPart = swView.ReferencedDocument

                                       

                                      I'm unsure if you will need the set statement. Some versions of VB require it some don't.

                                       

                                      Greg Johnson

                                        • Re: Accessing the drawing number thru VBA
                                          Jason Wilger

                                          Greg,

                                          Back at work today. I tried the suggestions you made, but still get errors. I have pasted the code below. There is some of Keith's code and some of your code. I am getting obect required and type mismatch errors now. Thanks for all of your help.

                                          Dim longstatus As Long, longwarnings As Long

                                          Dim Feature As Object

                                          Dim swSheet As SldWorks.Sheet

                                          Dim swDraw As SldWorks.DrawingDoc

                                          Dim bRet As Boolean

                                          Dim i As Long

                                          Dim vSheetProps As Variant

                                          Dim swModelDoc As SldWorks.ModelDoc2 'new

                                          Dim swModelDocExt As SldWorks.ModelDocExtension 'new

                                          Dim swCustomPropMgr As SldWorks.CustomPropertyManager 'new

                                          Dim strValOut As String 'new

                                          Dim strResolvedValOut As String 'new

                                          Dim dwgno As String 'new

                                          Dim dwgno1 As String 'new

                                          Const swTiffPrintScaleToFit As Long = 28

                                          Const swTiffScreenOrPrintCapture As Long = 6

                                          Const swTiffImageType As Long = 7

                                          Const swTiffCompressionScheme As Long = 8

                                          Const swTiffPrintDPI As Long = 9

                                          Const swTiffPrintPaperSize As Long = 10

                                           

                                          Sub main()

                                          Set swApp = Application.SldWorks

                                          Set swModel = swApp.ActiveDoc

                                          f = "C:\SOLIDWORKS COMPONENTS\New folder\"

                                          Debug.Print "PrintScaleToFit        = " + Str(swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swTiffPrintScaleToFit, True))

                                          Debug.Print "ScreenOrPrintCapture   = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture, 1))

                                          Debug.Print "allorcurrentsheet      = " + Str(swApp.SetUserPreferenceIntegerValue(swallorcurrentsheet, 1))

                                          Debug.Print "ImageType              = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffImageType, 0))

                                          Debug.Print "CompressionScheme      = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffCompressionScheme, 2))

                                          Debug.Print "PrintDPI               = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintDPI, 200))

                                          Debug.Print "PrintPaperSize         = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintPaperSize))

                                           

                                          file = Dir(f)

                                              Do While file <> ""

                                              filen = f + file

                                              namelength = Len(filen)

                                              filetype = Mid(filen, (namelength - 5), 7)

                                              namelength1 = Len(file)

                                              filename1 = Mid(file, 1, (namelength1 - 7))

                                              Debug.Print file

                                              Debug.Print filename1

                                              lcasefiletype = LCase(filetype)

                                                  If lcasefiletype = "slddrw" Then

                                                          Set Part = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                                                          swApp.OpenDoc6 filen, 3, 0, "", longstatus, longwarnings

                                                          Set swModel = swApp.ActiveDoc

                                                                          Set swDraw = swModel

                                                                  bRet = swDraw.ActivateSheet("Sheet1")

                                                                  Set swSheet = swDraw.GetCurrentSheet

                                                                  vSheetProps = swSheet.GetProperties

                                                          Set swDraw = DrawingDoc 'new

                                                          Set swPart = ModelDoc2 'new

                                                          Set swView = View 'new

                                                          Set ModelDoc = swPart 'new

                                                          Set swView = swDraw.GetFirstView() 'new

                                                          Set swView = swView.GetNextView() 'new

                                                          Debug.Print ("Selecting a component" + swView.GetName2()) 'new

                                                          Set swPart = swView.ReferencedDocument 'new

                                                          Set swModelDoc = swDraw 'new

                                                          Set swModelDocExt = swModelDoc.Extension 'new

                                                          Set swCustomPropMgr = swModelDocExt.CustomPropertyManager("") 'new

                                                          dwgno = swCustomPropMgr.Get4("Dwg No", False, strValOut, strResolvedValOut) 'new

                                                          dwgno1 = strValOut 'new

                                              Debug.Print "  TemplateName              = " & swSheet.GetTemplateName

                                              Debug.Print "  PaperSize                 = " & vSheetProps(0)

                                              Debug.Print "PrintPaperSize         = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintPaperSize, vSheetProps(0)))

                                                                  Part.SaveAs2 f + filename1 & ".TIF", 0, True, False

                                                          Set Part = Nothing

                                                          swApp.CloseDoc f + file

                                                  Else

                                                  End If

                                           

                                              file = Dir()

                                          Loop

                                          End Sub

                                           

                                          Jason

                                            • Re: Accessing the drawing number thru VBA
                                              Keith Hooks

                                              It looks like you're going through all of the drawing files in a folder and saving them out as TIF files.  Just so I'm clear - you want to name the TIF file the same as the Referenced Model's "Dwg No" field.  Is that right?  You're not trying to use the drawing's custom properties as the filename.

                                              • Re: Accessing the drawing number thru VBA
                                                Keith Hooks

                                                I dug into this a little bit more.  I commented out some lines that I felt weren't neccessary and it 'seems' to execute without errors.  Your drawing is the file you're actually saving, so you can still use the swModelDoc that represents the drawing throughout the execution.  I also don't think there's any reason you need to get a handle to the activesheet once you've activated it since the properties you want are in the referenced model.

                                                 

                                                I also recommend using the Path class to get your file extensions or otherwise manipulate a file Path.  It will save you a ton of headaches.  There are also simpler ways to iterate over files in a directory (especially in .NET 4.0) but I didn't change that here for now.

                                                 

                                                I did comment out the line that sets the swTiffPrintToScale option because it gave me an inexplicable compile error.  Hopefully it works for you.

                                                 

                                                Public swApp As SldWorks

                                                 

                                                 

                                                    Public Sub main()

                                                 

                                                 

                                                        Dim longstatus As Long, longwarnings As Long

                                                        'Dim Feature As Object

                                                        Dim swSheet As Sheet

                                                        Dim swDraw As DrawingDoc

                                                        Dim swPart As PartDoc

                                                        Dim bRet As Boolean

                                                        Dim f As String

                                                        'Dim i As Long

                                                        Dim file As String

                                                        Dim filen As String

                                                        'Dim filetype As String

                                                        Dim filename1 As String

                                                        Dim lcasefiletype As String

                                                        'Dim namelength As Integer

                                                        'Dim namelength1 As Integer

                                                        Dim vSheetProps As Object

                                                        Dim swModelDoc As ModelDoc2 'new

                                                        Dim swView As View

                                                        Dim swModelDocExt As ModelDocExtension 'new

                                                        Dim swCustomPropMgr As CustomPropertyManager 'new

                                                        Dim strValOut As String 'new

                                                        Dim strResolvedValOut As String 'new

                                                        Dim dwgno As String 'new

                                                        'Dim dwgno1 As String 'new

                                                        'Const swTiffPrintScaleToFit As Long = 28

                                                        Const swTiffScreenOrPrintCapture As Long = 6

                                                        Const swTiffImageType As Long = 7

                                                        Const swTiffCompressionScheme As Long = 8

                                                        Const swTiffPrintDPI As Long = 9

                                                        Const swTiffPrintPaperSize As Long = 10

                                                 

                                                 

                                                        'swModel = swApp.ActiveDoc

                                                 

                                                 

                                                        f = "C:\SOLIDWORKS COMPONENTS\New folder\"

                                                 

                                                 

                                                        'Debug.Print("PrintScaleToFit        = " + Str(swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swTiffPrintScaleToFit, True)))

                                                 

                                                 

                                                        Debug.Print("ScreenOrPrintCapture   = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture, 1)))

                                                        'Debug.Print("allorcurrentsheet      = " + Str(swApp.SetUserPreferenceIntegerValue(swallorcurrentsheet, 1)))

                                                        Debug.Print("ImageType              = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffImageType, 0)))

                                                        Debug.Print("CompressionScheme      = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffCompressionScheme, 2)))

                                                        Debug.Print("PrintDPI               = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintDPI, 200)))

                                                        Debug.Print("PrintPaperSize         = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintPaperSize)))

                                                 

                                                 

                                                        file = Dir(f)

                                                        Do While file <> ""

                                                 

                                                 

                                                            filen = f + file

                                                            'namelength = Len(filen)

                                                            'filetype = Mid(filen, (namelength - 5), 7)

                                                            'namelength1 = Len(file)

                                                            'filename1 = Mid(file, 1, (namelength1 - 7))

                                                            Debug.Print(file)

                                                            Debug.Print(filename1)

                                                            'lcasefiletype = LCase(filetype)

                                                            lcasefiletype = Path.GetExtension(filen)

                                                 

                                                 

                                                            If lcasefiletype = "slddrw" Then

                                                                'Part = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                                                                swModelDoc = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                                                                'swModelDoc = swApp.ActiveDoc

                                                                swDraw = swModelDoc

                                                                bRet = swDraw.ActivateSheet("Sheet1")

                                                                'swSheet = swDraw.GetCurrentSheet

                                                                'vSheetProps = swSheet.GetProperties

                                                                swView = swDraw.GetFirstView() 'new

                                                                swView = swView.GetNextView() 'new

                                                                Debug.Print("Selecting a component" + swView.GetName2()) 'new

                                                                swPart = swView.ReferencedDocument 'new

                                                 

                                                 

                                                                swModelDocExt = swPart.Extension 'new

                                                                swCustomPropMgr = swModelDocExt.CustomPropertyManager("") 'new

                                                                dwgno = swCustomPropMgr.Get4("Dwg No", False, strValOut, strResolvedValOut) 'new

                                                                'dwgno1 = strValOut 'new

                                                                Debug.Print("  TemplateName              = " & swSheet.GetTemplateName)

                                                                Debug.Print("  PaperSize                 = " & vSheetProps(0))

                                                                Debug.Print("PrintPaperSize         = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintPaperSize, vSheetProps(0))))

                                                                swModelDoc.SaveAs2(f + filename1 & ".TIF", 0, True, False)

                                                                'swPart = Nothing

                                                                swApp.CloseDoc(filen)

                                                            Else

                                                            End If

                                                        Loop

                                                    End Sub

                                • Re: Accessing the drawing number thru VBA
                                  Jason Wilger

                                  With some help from Keith, Greg, and some other threads, I got the macro to work. Here is the final product:

                                  Dim longstatus As Long, longwarnings As Long

                                  Dim swSheet As SldWorks.Sheet

                                  Dim swDraw As SldWorks.DrawingDoc

                                  Dim swPart As SldWorks.PartDoc

                                  Dim swView As SldWorks.View

                                  Dim bRet As Boolean

                                  Dim f As String

                                  Dim file As String

                                  Dim filen As String

                                  Dim filename1 As String

                                  Dim strModstring As String

                                  Dim strfilename As String

                                  Dim strresfilename As String

                                  Dim sname As String

                                  Dim sValue As String

                                  Dim lcasefiletype As String

                                  Dim vSheetProps As Variant

                                  Dim swModelDoc As SldWorks.ModelDoc2

                                  Const swTiffPrintScaleToFit As Long = 28

                                  Const swTiffScreenOrPrintCapture As Long = 6

                                  Const swTiffImageType As Long = 7

                                  Const swTiffCompressionScheme As Long = 8

                                  Const swTiffPrintDPI As Long = 9

                                  Const swTiffPrintPaperSize As Long = 10

                                   

                                   

                                   

                                  Sub main()

                                   

                                  Set swApp = Application.SldWorks

                                  Set swModel = swApp.ActiveDoc

                                  f = "C:\SOLIDWORKS COMPONENTS\New folder\"

                                  Debug.Print "PrintScaleToFit        = " + Str(swApp.SetUserPreferenceToggle(swUserPreferenceToggle_e.swTiffPrintScaleToFit, True))

                                  Debug.Print "ScreenOrPrintCapture   = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffScreenOrPrintCapture, 1))

                                  Debug.Print "allorcurrentsheet      = " + Str(swApp.SetUserPreferenceIntegerValue(swallorcurrentsheet, 1))

                                  Debug.Print "ImageType              = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffImageType, 0))

                                  Debug.Print "CompressionScheme      = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffCompressionScheme, 2))

                                  Debug.Print "PrintDPI               = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintDPI, 200))

                                  Debug.Print "PrintPaperSize         = " + Str(swApp.GetUserPreferenceIntegerValue(swTiffPrintPaperSize))

                                   

                                  file = Dir(f)

                                      Do While file <> ""

                                      filen = f + file

                                      namelength = Len(filen)

                                      filetype = Mid(filen, (namelength - 5), 7)

                                      namelength1 = Len(file)

                                      filename1 = Mid(file, 1, (namelength1 - 7))

                                      Debug.Print file

                                      Debug.Print filename1

                                      lcasefiletype = LCase(filetype)

                                          If lcasefiletype = "slddrw" Then

                                                  Set Part = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                                                  Set swModelDoc = swApp.OpenDoc6(filen, 3, 0, "", longstatus, longwarnings)

                                                  Set swModel = swApp.ActiveDoc

                                                                  Set swDraw = swModel

                                                          bRet = swDraw.ActivateSheet("Sheet1")

                                                          Set swSheet = swDraw.GetCurrentSheet

                                                          vSheetProps = swSheet.GetProperties

                                                          Set swView = swDraw.GetFirstView

                                                          Set swView = swView.GetNextView

                                                          strfilename = swView.ReferencedDocument.GetPathName

                                                          strresfilename = Left(strfilename, Len(strfilename) - 7)

                                                          strModstring = Right(strresfilename, intcount)

                                                  sname = "Dwg No"

                                                  sValue = swView.ReferencedDocument.CustomInfo2("", sname)

                                      Debug.Print "  TemplateName              = " & swSheet.GetTemplateName

                                      Debug.Print "  PaperSize                 = " & vSheetProps(0)

                                      Debug.Print "PrintPaperSize         = " + Str(swApp.SetUserPreferenceIntegerValue(swTiffPrintPaperSize, vSheetProps(0)))

                                                          swModelDoc.SaveAs2 f + sValue & ".TIF", 0, True, False

                                                  Set Part = Nothing

                                                  swApp.CloseDoc f + file

                                          Else

                                          End If

                                   

                                      file = Dir()

                                  Loop

                                  End Sub

                                  I did a test run with 50 drawings and it worked seamlessly. I think a lot of the problem is with the VB version. I am currently running 2012, and this may be the issue.