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
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
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.
On Jul 22, 5:06 pm, snipped-for-privacy@terex.com.au wrote:
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
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?
Polytechforum.com is a website by engineers for engineers. It is not affiliated with any of manufacturers or vendors discussed here.
All logos and trade names are the property of their respective owners.