SOLIDWORKS API SAVEAS3 PROBLEM
SOLIDWORKS API SAVEAS3 PROBLEM
(OP)
Hi,
I wrote a macro that takes the active part, determine if it s a part or a drawing, and if it s a part, then change some properties and perform a saveas with the same name. Everything is ok, but for the drawing, the macro select every sheet, copy, then open new template, paste sheet , close original file ans saveas.
The problem is that the macro have work for a while but now it wont saveas.. I must saveas before to paste to be able to do it. event with a sendkeys there is no way to save document, and no error message or something. Can someone check my code and tell me wath is wrong? Im not a pro. with macro..but the code sound ok..maybe to much lines..but ok.
I wrote a macro that takes the active part, determine if it s a part or a drawing, and if it s a part, then change some properties and perform a saveas with the same name. Everything is ok, but for the drawing, the macro select every sheet, copy, then open new template, paste sheet , close original file ans saveas.
The problem is that the macro have work for a while but now it wont saveas.. I must saveas before to paste to be able to do it. event with a sendkeys there is no way to save document, and no error message or something. Can someone check my code and tell me wath is wrong? Im not a pro. with macro..but the code sound ok..maybe to much lines..but ok.
- Dim vSheetName As Variant
- Dim swView As SldWorks.View
- Dim swDraw As SldWorks.DrawingDoc
- Dim swAnn As SldWorks.Annotation
- Dim swSelMgr As SldWorks.SelectionMgr
- Dim SWNOTE As SldWorks.NOTE
- Dim S As String
- Dim swCustPropMgr As SldWorks.CustomPropertyManager
- Dim SheetCount As Integer
- Dim DOC As ModelDoc2
- Dim boolstatus As Boolean
- Dim longstatus As Long, longwarnings As Long
- Dim PART As Object
- Dim PARTTITLE As String
- Dim X As String
- Public Z As String
- Public Q As String
- Dim SWAPP As SldWorks.SldWorks
- Dim swModel As ModelDoc2
- Dim nErrors As Long
- Sub main()
- Dim Answer As String
- Dim MyNote As String
- 'Place your text here
- MyNote = "DO YOU REALLY WISH TO REFRESH" & Chr(13) & "ACTUAL DOCUMENT AUTHOR AND DATE?"
- 'Display MessageBox
- Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???")
- If Answer = vbNo Then
- 'Code for No button Press
- MsgBox "OPERATION ABORT BY USER!"
- Exit Sub
- 'Code for Yes button Press
- End If
- Z = 0
- A = 0
- Set SWAPP = Application.SldWorks
- Set DOC = SWAPP.ACTIVEDOC
- If DOC Is Nothing Then MsgBox "A SOLIDWORKS DOCUMENT MUST BE OPEN" & Chr(13) & "TO PERFORM REFRESH THIS WAY!!": End
- Dim swDocTypeLong As Long
- Set PART = SWAPP.ACTIVEDOC
- EXT = Right(PART.GetPathName, 7)
- swDocTypeLong = Switch(EXT = ".SLDPRT", swDocPART, EXT = ".SLDDRW", swDocDRAWING, EXT = ".SLDASM", swDocASSEMBLY, True, -1)
- X = PART.GetPathName
- PARTTITLE = PART.GetTitle
- If swDocTypeLong = swDocDRAWING Then GoTo 2
- UserForm3.Show
- If Z = 1 Then Exit Sub
- Set SWAPP = Application.SldWorks
- Set DOC = SWAPP.ACTIVEDOC
- 'boolstatus = swApp.CloseAllDocuments(True)
- 'Debug.Print boolstatus
- 'If swDocTypeLong = swDocPART Then GoTo 4
- 'If swDocTypeLong = swDocASSEMBLY Then GoTo 4
- Set PART = SWAPP.ACTIVEDOC
- Set swModel = SWAPP.ACTIVEDOC
- Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
- swCustPropMgr.Add2 "DESIGN DATE", swCustomInfoText, " "
- swCustPropMgr.Set "DESIGN DATE", Q
- PART.DeleteAllRelations
- Dim swEquationMgr As Object
- Set swEquationMgr = PART.GetEquationMgr()
- swEquationMgr.add -1, Chr(34) & "Autorun""" & "=" & "Application.SldWorks.RunMacro" & "(" & """" & "C" & ":" & "\" & "SOLIDWORKS" & " " & "MACRO" & "\" & "MACRO4.swp" & """,""" & "MACRO41" & """,""main" & """)"
- swModel.SummaryInfo(SwConst.swSumInfoAuthor) = "PAT LAFONTAINE"
- GoTo 6
- 2 Set PART = SWAPP.ACTIVEDOC
- Set swModel = SWAPP.ACTIVEDOC
- Set SWDWG = swModel
- Set swDraw = swModel
- vSheetName = swDraw.GetSheetNames
- 'For i = 0 To UBound(vSheetName)
- SheetCount = PART.GetSheetCount
- SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount))
- PARTTITLE = PART.GetTitle
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 1), "SHEET", 0, 0, 0, False, 0, Nothing, 0)
- If SheetCount - 1 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 2), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 2 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 3), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 3 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 4), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 4 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 5), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 5 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 6), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 6 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 7), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 7 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 8), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 8 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 9), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 9 = 0 Then GoTo 8
- boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 10), "SHEET", 0, 0, 0, True, 0, Nothing, 0)
- If SheetCount - 10 > 0 Then MsgBox "DRAWING COUNTAIN MORE THAN 10 SHEETS," & Chr(13) & "ONLY 10 FIRST WILL BE COPY," & Chr(13) & "SO CHECK TO MANUALLY COPY MISSING SHEETS."
- 8 PART.EditCopy
- 'If Right(M, 6) = "SLDASM" Then Set PART = swApp.NewDocument("s:\aaatemplates\solidworks 2010 template\fond de plan\ASSY-D_Orientech.slddrt", 12, 0.2794, 0.4318)
- Set PART = SWAPP.NewDocument("s:\aaatemplates\solidworks 2010 template\DRAWING.drwdot", 12, 0.2794, 0.4318)
- SWAPP.ActivateDoc2 "Draw7 - Sheet1", False, longstatus
- Set PART = SWAPP.ACTIVEDOC
- Dim myDrawingSheet As Object
- Set myDrawingSheet = PART.GetCurrentSheet()
- myDrawingSheet.SetName "SHEET TO DELETE"
- Set PART = SWAPP.ACTIVEDOC
- boolstatus = PART.Extension.SelectByID2("SHEET TO DELETE", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
- PART.Paste
- Set swModel = SWAPP.ACTIVEDOC
- Set SWDWG = swModel
- Set swDraw = swModel
- vSheetName = swDraw.GetSheetNames
- SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - 1))
- Set swModel = SWAPP.ACTIVEDOC
- Set swDraw = swModel
- Set swSheet = swDraw.GetCurrentSheet
- Set swSelMgr = swModel.SelectionManager
- Set swView = swDraw.GetFirstView
- Set swView = swView.GetNextView
- Set swModel = SWAPP.ACTIVEDOC
- Set SWDWG = swModel
- SWDWG.ActivateSheet "SHEET TO DELETE"
- M = swView.ReferencedDocument.GetPathName
- Set PART = SWAPP.ACTIVEDOC
- Dim MYView As Object
- Set MYiew = PART.CreateDrawViewFromModelView3(M, "*Front", 0.1097457655955, 0.1648856124764, 0)
- Set swModel = SWAPP.ACTIVEDOC
- Set SWDWG = swModel
- sSheetNames = SWDWG.GetSheetCount
- Set swSelMgr = swModel.SelectionManager
- Set swModel = SWAPP.ACTIVEDOC
- Set PART = SWAPP.ACTIVEDOC
- boolstatus = PART.Extension.SelectByID2("DetailItem346@Sheet Format1", "NOTE", 0.4080223743143, -0.001548983140407, 0, False, 0, Nothing, 0)
- Set SWNOTE = swSelMgr.GetSelectedObject6(1, 0)
- Set swAnn = SWNOTE.GetAnnotation
- S = SWNOTE.GetText
- SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - 1))
- Set myDrawingSheet = PART.GetCurrentSheet()
- Set swDraw = swModel
- Set swSheet = swDraw.GetCurrentSheet
- myDrawingSheet.SetName "Sheet1"
- boolstatus = PART.Extension.SelectByID2("SET AUTHOR NAME & PROPERTY1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
- 'part.DeleteSelection (False)
- If boolstatus = True Then GoTo 9
- boolstatus = SWAPP.RunMacro2("c:\SOLIDWORKS MACRO\DWG.swp", "MACROFEATURE_MODULE1", "main", swRunMacroUnloadAfterRun, nErrors)
- 9 vSheetProps = swSheet.GetProperties
- 'Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")
- 'swCustPropMgr.Add2 "DOCTYPE", swCustomInfoText, " "
- 'swCustPropMgr.Set "DOCTYPE", "$PRPSHEET" & ":" & Chr(34) & "DOCTYPE"""
- 'Set part = swApp.ACTIVEDOC
- 'S = swCustPropMgr.Get("DOCTYPE")
- If S = " " Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If S = " " Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If S = "" Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If S = "" Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- D = 2
- 3 If sSheetNames = D Then GoTo 5
- SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - D))
- Set PART = SWAPP.ACTIVEDOC
- Set myDrawingSheet = PART.GetCurrentSheet()
- Set swDraw = swModel
- Set swSheet = swDraw.GetCurrentSheet
- vSheetProps = swSheet.GetProperties
- If A = 1 Then If S = " " Then boolstatus = PART.SetupSheet5("Sheet" & D - 1, 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 1 Then If S = " " Then boolstatus = PART.SetupSheet5("Sheet" & D - 1, 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 0 Then If S = " " Then boolstatus = PART.SetupSheet5("Sheet" & D, 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 0 Then If S = " " Then boolstatus = PART.SetupSheet5("Sheet" & D, 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 1 Then If S = "" Then boolstatus = PART.SetupSheet5("Sheet" & D - 1, 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 1 Then If S = "" Then boolstatus = PART.SetupSheet5("Sheet" & D - 1, 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 0 Then If S = "" Then boolstatus = PART.SetupSheet5("Sheet" & D, 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 0 Then If S = "" Then boolstatus = PART.SetupSheet5("Sheet" & D, 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)
- If A = 1 Then A = 0
- 'myDrawingSheet.SetName "Sheet" & D
- Dim bRet As Boolean
- Set SWAPP = CreateObject("SldWorks.Application")
- Set swModel = SWAPP.ACTIVEDOC
- Set swDraw = swModel
- Set swSheet = swDraw.GetCurrentSheet
- Set swView = swDraw.GetFirstView
- Debug.Print "File = " & swModel.GetPathName
- Debug.Print " " & swSheet.GetName
- While Not swView Is Nothing
- Debug.Print " " & swView.GetName2 & " [" & swView.Type & "]"
- Set swView = swView.GetNextView
- While swView Is Nothing
- boolstatus = PART.Extension.SelectByID2("Sheet" & D, "SHEET", 0, 0, 0, False, 0, Nothing, 0)
- PART.DeleteSelection (False)
- A = 1
- GoTo 4
- Wend
- GoTo 4
- Wend
- 4 D = D + 1
- GoTo 3
- 5 'swDwg.ActivateSheet "SHEET TO DELETE"
- boolstatus = PART.Extension.SelectByID2("SHEET TO DELETE", "SHEET", 0, 0, 0, False, 0, Nothing, 0)
- PART.DeleteSelection (False)
- 'part.EditDelete
- swModel.SummaryInfo(SwConst.swSumInfoAuthor) = "PAT LAFONTAINE"
- PARTTITLE2 = PART.GetTitle
- SWAPP.CloseDoc PARTTITLE
- Set PART = SWAPP.ActivateDoc2(PARTTITLE2, 0, 0)
- 'PART.Save2 (silent)
- Set PART = SWAPP.ACTIVEDOC
- 'Dim i As Integer
- ' Set SWAPP = Application.SldWorks
- ' SendKeys "%{F}" 'invoke file menu
- ' For i = 0 To 3 'go down to the saveas dialog
- ' SendKeys "{down}"
- ' Next i
- 'SendKeys "{enter}" 'enter
- longstatus = PART.SaveAs3(X, 0, 0)
- If swDocTypeLong = swDocDRAWING Then GoTo 11
- 6 longstatus = PART.SaveAs3(X, 0, 0)
- Set PART = Nothing
- Dim Answer3 As String
- Dim MyNote3 As String
- 'Place your text here
- MyNote3 = "DO YOU WISH TO CLOSE DOCUMENT?"
- 'Display MessageBox
- Answer3 = MsgBox(MyNote3, vbQuestion + vbYesNo, "???")
- If Answer3 = vbNo Then
- 'Code for No button Press
- GoTo 10
- 'Code for Yes button Press
- End If
- SWAPP.CloseDoc PARTTITLE
- GoTo 10
- 11 Set PART = SWAPP.ACTIVEDOC
- PARTTITLE = PART.GetTitle
- Set PART = Nothing
- Dim Answer2 As String
- Dim MyNote2 As String
- 'Place your text here
- MyNote2 = "DO YOU WISH TO CLOSE DOCUMENT?"
- 'Display MessageBox
- Answer2 = MsgBox(MyNote2, vbQuestion + vbYesNo, "???")
- If Answer2 = vbNo Then
- 'Code for No button Press
- GoTo 10
- 'Code for Yes button Press
- End If
- SWAPP.CloseDoc PARTTITLE
- 10 MsgBox "REFRESH DONE!" ' Define title.
- End
- End Sub





