macro to change sheet formats

Discussion in 'SolidWorks' started by r.obryan, Jul 23, 2007.

  1. r.obryan

    r.obryan Guest

    I have a series of drawings which need to be released to the factory
    on a standard company title block, and also published to a spare parts
    manual on a spare parts specific title block. The drawings are exactly
    the same in both instances, except for the title block. I have tried
    to create a macro to do this for me, however I am not having much
    luck. I begin recording the macro and do the following steps:

    1. right-click in a blank area in the drawing sheet
    2. select 'Properties' from the menu
    3. select alternative sheet format
    4. click 'OK' to accept the change
    5. stop recording

    When i go to run the macro i get a run-time 450 message, saying wrong
    number of argument or invalid property assignment. Can anyone suggest
    anything or any existing macros to do the same thing? Any help would
    be much appreciated

    Ross
     
    r.obryan, Jul 23, 2007
    #1
  2. r.obryan

    fcsuper Guest

    This is beyond the Recorder's abilities. However, can you post what
    you do have?

    Matt Lorono
    http://sw.fcsuper.com
     
    fcsuper, Jul 23, 2007
    #2
  3. r.obryan

    r.obryan Guest

    Hi Matt,
    thanks for the reply. i thought it would have been too complex for the
    recorder to handle, but thought i'd give it a go. I am basically a
    beginner to VBA. The code i got when i recorded the macro is as
    follows:

    '
    ******************************************************************************
    ' C:\DOCUME~1\robryan\LOCALS~1\Temp\swx2688\Macro1.swb - macro
    recorded on 07/23/07 by robryan
    '
    ******************************************************************************
    Dim swApp As Object
    Dim Part As Object
    Dim SelMgr As Object
    Dim boolstatus As Boolean
    Dim longstatus As Long, longwarnings As Long
    Dim Feature As Object
    Sub main()

    Set swApp = Application.SldWorks

    Set Part = swApp.ActiveDoc
    Set SelMgr = Part.SelectionManager
    boolstatus = Part.Extension.SelectByID2("Model", "SHEET",
    0.05811514508374, 0.05515442212416, 0, False, 0, Nothing, 0)
    Part.ClearSelection2 True
    Part.SetupSheet4 "Model", 12, 12, 1, 10, False, "A4 - SPARE.slddrt",
    0.21, 0.297, "Default", True
    End Sub
     
    r.obryan, Jul 23, 2007
    #3
  4. r.obryan

    esobota Guest

    One of my coworkers made a similar macro. I don't have it with me,
    but I remember he had an issues with it. When you record the macro,
    the call setting the sheet format has an extra argument that won't
    play back. It's the argument telling the sheet format to be visible,
    the last argument in the call. If you delete that one, then the macro
    will run, but it will have the sheet format turned off. You'll need
    to add an extra command to turn the sheet format back on.
     
    esobota, Jul 23, 2007
    #4
  5. r.obryan

    Elmo Guest

    Hello Ross

    Go to http://solidworks.cad.de/mm_29.htm
    This is the Stefan Berlitz site and the macro
    does just what you want. Its in german but
    thats okay...

    Eman
     
    Elmo, Jul 23, 2007
    #5
  6. r.obryan

    r.obryan Guest

    Hi Eman,
    thanks for the link. It sounds like that would be ideal if i were able
    to get it working properly, however i have a very limited experience
    with macros. i thought i followed the instructions fairly well, but
    still had an error message come up. i keep getting msgtext(3) appear
    "***ERROR: Can't set new sheetformat. Sheetformat file exists?" i
    changed the path and also added in the sheetformat names that
    currently exist. am a bit lost. attached is the code:

    '
    **********************************************************************
    ' * PLEASE change the path/filename for the sheet templates (see
    below)
    '
    **********************************************************************
    ' * Macro changes the sheetformat (= the "paper" of your drawing) for
    ' * all sheets of the active drawing. You have to adjust the path and
    ' * the file names to the new sheet formats. After successfully
    changing
    ' * the sheetformat the drawing is saved with its current name.
    ' * ATTENTION: you CAN'T change the drawing template, this is not
    ' * possible. So with this macro you can't update document properties.
    ' * All sheet formats will be "userdefinied" after updating with this
    ' * macro. If you want to have the "standard" A-A0 formats and not
    ' * userdefinied you have to change the macro accordingly or use its
    ' * "compagnion" which reloads a standard sheettemplate
    ' *
    ' * This macro is intended to be used with PAC4SWX for batch reloading
    ' * of sheetformats, in case you changed you sheetformat with a new
    ' * company logo, new title block layout or similar. But it will also
    ' * word if fired from the GUI (taskplaner not tested, but should
    work;
    ' * but I would like to see you using PAC4SWX instead of
    taskplaner ;-))
    ' *
    ' * PAC4SWX - http://swtools.cad.de/prog_pac.htm
    ' *
    ' * 17.12.2003 Stefan Berlitz
    ' * SolidWorks Solution Partner
    ' * http://swtools.cad.de
    ' * http://solidworks.cad.de
    ' *
    '
    **********************************************************************

    Dim msgtext(6) As String ' some texts for multi-language support


    Sub main()

    Dim sheetformatpath(12) As String
    Dim sheetformatdir As String

    ' choose active language
    CheckLanguage

    ' ************ EDIT path and file name HERE
    ************************

    ' After editing the sheetformats delete the next line or comment
    it
    'If MsgBox(msgtext(6), vbOKOnly, "Please Edit Macro") = vbOK Then
    End

    ' Path to directory with sheetformats
    sheetformatdir = "U:\SOLIDWORKS\SOLIDWORKS ADMIN\TEREX-Templates"

    ' path to the various sheet formats from A to A0, you may also use
    ' full pathnames, but if they are all in the same subdir it's
    easier this way
    sheetformatpath(0) = sheetformatdir & "A4 - TEREX.slddrt"
    sheetformatpath(1) = sheetformatdir & "A4 - SPARE.slddrt"
    sheetformatpath(2) = sheetformatdir & "A3 - TEREX.slddrt"
    'sheetformatpath(3) = sheetformatdir & "temp_c.slddrt"
    'sheetformatpath(4) = sheetformatdir & "temp_d.slddrt"
    'sheetformatpath(5) = sheetformatdir & "temp_e.slddrt"
    'sheetformatpath(6) = sheetformatdir & "temp_a4.slddrt"
    'sheetformatpath(7) = sheetformatdir & "temp_a4v.slddrt"
    'sheetformatpath(8) = sheetformatdir & "temp_a3.slddrt"
    'sheetformatpath(9) = sheetformatdir & "temp_a2.slddrt"
    'sheetformatpath(10) = sheetformatdir & "temp_a1.slddrt"
    'sheetformatpath(11) = sheetformatdir & "temp_a0.slddrt"
    ' already user defined
    sheetformatpath(12) = sheetformatdir & "A4 - BLANK.slddrt"

    ' ************************* EDIT END
    *******************************



    ' zunächst mal ein paar Deklarartionen die gebraucht werden
    Dim SwApp As Object
    Dim DrawingDoc As Object
    Dim Sheet As Object

    Dim Titel As String
    Dim Datei As String
    Dim temp As String
    Dim pfad As String
    Dim msgtxt As String

    Dim Name As String
    Dim paperSize As Long
    Dim templateIn As Long
    Dim scale1 As Double
    Dim scale2 As Double
    Dim firstAngle As Boolean
    Dim templateName As String
    Dim Width As Double
    Dim Height As Double
    Dim propertyViewName As String

    Dim i As Long
    Dim AnzahlBl As Long
    Dim SheetNames As Variant
    Dim SheetProperties As Variant

    Const swDocDRAWING = 3
    Const swDwgTemplateCustom = 12
    Const swDwgTemplateNone = 13

    ' attach to SolidWorks
    Set SwApp = CreateObject("SldWorks.Application")

    Set DrawingDoc = SwApp.ActiveDoc

    If DrawingDoc Is Nothing Then
    ' check if document is open
    MsgBox msgtext(0)
    Exit Sub
    End If

    If (DrawingDoc.GetType <> swDocDRAWING) Then
    ' check if document is a drawing
    MsgBox msgtext(1)
    Exit Sub
    End If


    ' get sheet count and traverse all sheets to reload sheetformat
    '
    AnzahlBl = DrawingDoc.GetSheetCount
    SheetNames = DrawingDoc.GetSheetNames

    ' reset error messages
    msgtxt = ""

    For i = 0 To AnzahlBl - 1
    ' activate next sheet
    If DrawingDoc.ActivateSheet(SheetNames(i)) Then
    ' attach to sheet object
    Set Sheet = DrawingDoc.GetCurrentSheet
    SheetProperties = Sheet.GetProperties

    ' first we have to set the sheet to use "no sheetformat",
    for SolidWorks
    ' wont reload a sheetformat if it is the same name as
    before
    Name = Sheet.GetName
    paperSize = SheetProperties(0)
    ' set NO SHEETFORMAT
    templateIn = swDwgTemplateNone
    scale1 = SheetProperties(2)
    scale2 = SheetProperties(3)
    firstAngle = CBool(SheetProperties(4))
    ' no sheetformat = no path
    templateName = ""
    ' but we need the sheet size
    Width = SheetProperties(5)
    Height = SheetProperties(6)
    propertyViewName = Sheet.CustomPropertyView

    retval = DrawingDoc.SetupSheet4( _
    Name, _
    paperSize, _
    templateIn, _
    scale1, _
    scale2, _
    firstAngle, _
    templateName, _
    Width, _
    Height, _
    propertyViewName)
    If retval = False Then
    msgtxt = msgtxt & msgtext(2) & vbCrLf
    Else

    ' and now we set the new sheetformat; it is necessary
    to set
    ' USER DEFINED sheetformat for SolidWorks will look
    for the
    ' standard templates temp_??.slddrt in your spefified
    folder
    ' if using the standard sheet sizes.
    templateIn = swDwgTemplateCustom

    ' get correct sheetformat for this size depending on
    the
    ' papersize, this will allow aleady userdefined
    sheetformats
    ' to properly be reloaded
    paperSize = GetSheetSizeFromPaperSize(Width, Height)
    templateName = sheetformatpath(paperSize)

    retval = DrawingDoc.SetupSheet4( _
    Name, _
    paperSize, _
    templateIn, _
    scale1, _
    scale2, _
    firstAngle, _
    templateName, _
    Width, _
    Height, _
    propertyViewName)
    If retval = False Then
    ' ERROR : can't load new sheetformat
    msgtxt = msgtxt & msgtext(3) & templateName &
    vbCrLf
    Else

    ' everything worked fine, no message here for
    automation

    ' save the document without backup
    If DrawingDoc.Save2(True) > 0 Then
    ' error saving file
    msgtxt = msgtxt & msgtext(5) & vbCrLf
    End If

    End If

    End If
    Else
    msgtxt = msgtxt & msgtext(4) & Name & vbCrLf
    End If
    Next i

    ' und noch die Zusammenfassung übers Speichern ausgeben
    If Len(msgtxt) Then
    MsgBox msgtxt
    End If

    End Sub

    Private Sub CheckLanguage()

    ' check which language to apply. To make another language
    ' copy one of the CASE fileds and make your changes
    '

    Set SwApp = CreateObject("SldWorks.Application") ' set by Sub
    main()
    Select Case SwApp.GetCurrentLanguage
    Case "german"
    msgtext(0) = "Kein Dokument offen, was sollte ich denn wohl
    tun?"
    msgtext(1) = "Nur sinnvoll bei Zeichnungen"
    msgtext(2) = "*** FEHLER: konnte Blatt nicht zurücksetzen "
    msgtext(3) = "*** FEHLER: konnte Blatt nicht auf neuen
    Vordruck setzen. Vordruck vorhanden? "
    msgtext(4) = "*** FEHLER: konnte Blatt nicht aktivieren "
    msgtext(5) = "*** FEHLER: konnte Dokument nicht speichern "
    msgtext(6) = "Bitte erst das Makro anpassen, dazu auf Extras/
    Makros/Editieren klicken"
    ' Case "english"
    ' english is default, so change there
    ' Case "spanish"
    ' Case "french"
    ' Case "italian"
    ' Case "japanese"
    Case Else
    ' english is default
    msgtext(0) = "Nothing opened, so what should I look at?"
    msgtext(1) = "Only useful with drawing"
    msgtext(2) = "*** ERROR: can't reset sheet "
    msgtext(3) = "*** ERROR: can't set new sheetformat for
    drawing. Sheetformat file exists? "
    msgtext(4) = "*** ERROR: cant activate sheet "
    msgtext(5) = "*** ERROR: cant save document "
    msgtext(6) = "Please edit macro first (Extras/Macros/Edit)"
    End Select

    End Sub

    Function GetSheetSizeFromPaperSize(SheetWidth, SheetHeight)
    ' Function returns the SheetSize constant based on the width and
    heigth
    ' useful for userdefined sheetformats

    Const swDwgPaperAsize = 0
    Const swDwgPaperAsizeVertical = 1
    Const swDwgPaperBsize = 2
    Const swDwgPaperCsize = 3
    Const swDwgPaperDsize = 4
    Const swDwgPaperEsize = 5
    Const swDwgPaperA4size = 6
    Const swDwgPaperA4sizeVertical = 7
    Const swDwgPaperA3size = 8
    Const swDwgPaperA2size = 9
    Const swDwgPaperA1size = 10
    Const swDwgPaperA0size = 11
    Const swDwgPapersUserDefined = 12

    If (Round(SheetWidth, 4) = 0.2794) And (Round(SheetHeight, 4) =
    0.2159) Then
    GetSheetSizeFromPaperSize = swDwgPaperAsize
    ElseIf (Round(SheetWidth, 4) = 0.2159) And (Round(SheetHeight, 4)
    = 0.2794) Then
    GetSheetSizeFromPaperSize = swDwgPaperAsizeVertical
    ElseIf (Round(SheetWidth, 4) = 0.4318) And (Round(SheetHeight, 4)
    = 0.2794) Then
    GetSheetSizeFromPaperSize = swDwgPaperBsize
    ElseIf (Round(SheetWidth, 4) = 0.5588) And (Round(SheetHeight, 4)
    = 0.4318) Then
    GetSheetSizeFromPaperSize = swDwgPaperCsize
    ElseIf (Round(SheetWidth, 4) = 0.8636) And (Round(SheetHeight, 4)
    = 0.5588) Then
    GetSheetSizeFromPaperSize = swDwgPaperDsize
    ElseIf (Round(SheetWidth, 4) = 1.1176) And (Round(SheetHeight, 4)
    = 0.8636) Then
    GetSheetSizeFromPaperSize = swDwgPaperEsize
    ElseIf (Round(SheetWidth, 4) = 0.297) And (Round(SheetHeight, 4) =
    0.21) Then
    GetSheetSizeFromPaperSize = swDwgPaperA4size
    ElseIf (Round(SheetWidth, 4) = 0.21) And (Round(SheetHeight, 4) =
    0.297) Then
    GetSheetSizeFromPaperSize = swDwgPaperA4sizeVertical
    ElseIf (Round(SheetWidth, 4) = 0.42) And (Round(SheetHeight, 4) =
    0.297) Then
    GetSheetSizeFromPaperSize = swDwgPaperA3size
    ElseIf (Round(SheetWidth, 4) = 0.594) And (Round(SheetHeight, 4) =
    0.42) Then
    GetSheetSizeFromPaperSize = swDwgPaperA2size
    ElseIf (Round(SheetWidth, 4) = 0.841) And (Round(SheetHeight, 4) =
    0.594) Then
    GetSheetSizeFromPaperSize = swDwgPaperA1size
    ElseIf (Round(SheetWidth, 4) = 1.189) And (Round(SheetHeight, 4) =
    0.841) Then
    GetSheetSizeFromPaperSize = swDwgPaperA0size
    Else
    GetSheetSizeFromPaperSize = swDwgPapersUserDefined
    End If

    End Function


    any ideas?
     
    r.obryan, Jul 24, 2007
    #6
  7. r.obryan

    j Guest

    What about putting a border that has 2 levels on it. One would be for
    the shop border and the other level would be for the manual border.
     
    j, Jul 25, 2007
    #7
Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.