Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

SOLIDWORKS API SAVEAS3 PROBLEM

Status
Not open for further replies.

PAT44

Mechanical
Apr 4, 2012
12
CA
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.

[ul]
[li]Dim vSheetName As Variant[/li]
[li]Dim swView As SldWorks.View[/li]
[li]Dim swDraw As SldWorks.DrawingDoc[/li]
[li]Dim swAnn As SldWorks.Annotation[/li]
[li]Dim swSelMgr As SldWorks.SelectionMgr[/li]
[li]Dim SWNOTE As SldWorks.NOTE[/li]
[li]Dim S As String[/li]
[li]Dim swCustPropMgr As SldWorks.CustomPropertyManager[/li]
[li]Dim SheetCount As Integer[/li]
[li]Dim DOC As ModelDoc2[/li]
[li]Dim boolstatus As Boolean[/li]
[li]Dim longstatus As Long, longwarnings As Long[/li]
[li]Dim PART As Object[/li]
[li]Dim PARTTITLE As String[/li]
[li]Dim X As String[/li]
[li]Public Z As String[/li]
[li]Public Q As String[/li]
[li]Dim SWAPP As SldWorks.SldWorks[/li]
[li]Dim swModel As ModelDoc2[/li]
[li]Dim nErrors As Long[/li]
[li]Sub main()[/li]
[li]Dim Answer As String[/li]
[li]Dim MyNote As String[/li]
[li] 'Place your text here[/li]
[li] MyNote = "DO YOU REALLY WISH TO REFRESH" & Chr(13) & "ACTUAL DOCUMENT AUTHOR AND DATE?"[/li]
[li] 'Display MessageBox[/li]
[li] Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???")[/li]
[li] If Answer = vbNo Then[/li]
[li] 'Code for No button Press[/li]
[li] MsgBox "OPERATION ABORT BY USER!"[/li]
[li] Exit Sub[/li]
[li] 'Code for Yes button Press[/li]
[li][/li]
[li] End If[/li]
[li][/li]
[li]Z = 0[/li]
[li]A = 0[/li]
[li]Set SWAPP = Application.SldWorks[/li]
[li]Set DOC = SWAPP.ACTIVEDOC[/li]
[li]If DOC Is Nothing Then MsgBox "A SOLIDWORKS DOCUMENT MUST BE OPEN" & Chr(13) & "TO PERFORM REFRESH THIS WAY!!": End[/li]
[li]Dim swDocTypeLong As Long[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]EXT = Right(PART.GetPathName, 7)[/li]
[li]swDocTypeLong = Switch(EXT = ".SLDPRT", swDocPART, EXT = ".SLDDRW", swDocDRAWING, EXT = ".SLDASM", swDocASSEMBLY, True, -1)[/li]
[li]X = PART.GetPathName[/li]
[li]PARTTITLE = PART.GetTitle[/li]
[li] If swDocTypeLong = swDocDRAWING Then GoTo 2[/li]
[li][/li]
[li] UserForm3.Show[/li]
[li]If Z = 1 Then Exit Sub[/li]
[li]Set SWAPP = Application.SldWorks[/li]
[li]Set DOC = SWAPP.ACTIVEDOC[/li]
[li]'boolstatus = swApp.CloseAllDocuments(True)[/li]
[li] 'Debug.Print boolstatus[/li]
[li][/li]
[li]'If swDocTypeLong = swDocPART Then GoTo 4[/li]
[li]'If swDocTypeLong = swDocASSEMBLY Then GoTo 4[/li]
[li] Set PART = SWAPP.ACTIVEDOC[/li]
[li] Set swModel = SWAPP.ACTIVEDOC[/li]
[li]Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")[/li]
[li]swCustPropMgr.Add2 "DESIGN DATE", swCustomInfoText, " "[/li]
[li]swCustPropMgr.Set "DESIGN DATE", Q[/li]
[li]PART.DeleteAllRelations[/li]
[li]Dim swEquationMgr As Object[/li]
[li]Set swEquationMgr = PART.GetEquationMgr()[/li]
[li]swEquationMgr.add -1, Chr(34) & "Autorun""" & "=" & "Application.SldWorks.RunMacro" & "(" & """" & "C" & ":" & "\" & "SOLIDWORKS" & " " & "MACRO" & "\" & "MACRO4.swp" & """,""" & "MACRO41" & """,""main" & """)"[/li]
[li]swModel.SummaryInfo(SwConst.swSumInfoAuthor) = "PAT LAFONTAINE"[/li]
[li]GoTo 6[/li]
[li]2 Set PART = SWAPP.ACTIVEDOC[/li]
[li]Set swModel = SWAPP.ACTIVEDOC[/li]
[li]Set SWDWG = swModel[/li]
[li]Set swDraw = swModel[/li]
[li]vSheetName = swDraw.GetSheetNames[/li]
[li]'For i = 0 To UBound(vSheetName)[/li]
[li]SheetCount = PART.GetSheetCount[/li]
[li]SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount))[/li]
[li]PARTTITLE = PART.GetTitle[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 1), "SHEET", 0, 0, 0, False, 0, Nothing, 0)[/li]
[li]If SheetCount - 1 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 2), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 2 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 3), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 3 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 4), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 4 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 5), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 5 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 6), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 6 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 7), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 7 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 8), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 8 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 9), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]If SheetCount - 9 = 0 Then GoTo 8[/li]
[li]boolstatus = PART.Extension.SelectByID2(vSheetName(SheetCount - 10), "SHEET", 0, 0, 0, True, 0, Nothing, 0)[/li]
[li]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."[/li]
[li]8 PART.EditCopy[/li]
[li]'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)[/li]
[li] Set PART = SWAPP.NewDocument("s:\aaatemplates\solidworks 2010 template\DRAWING.drwdot", 12, 0.2794, 0.4318)[/li]
[li]SWAPP.ActivateDoc2 "Draw7 - Sheet1", False, longstatus[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]Dim myDrawingSheet As Object[/li]
[li]Set myDrawingSheet = PART.GetCurrentSheet()[/li]
[li]myDrawingSheet.SetName "SHEET TO DELETE"[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]boolstatus = PART.Extension.SelectByID2("SHEET TO DELETE", "SHEET", 0, 0, 0, False, 0, Nothing, 0)[/li]
[li]PART.Paste[/li]
[li]Set swModel = SWAPP.ACTIVEDOC[/li]
[li] Set SWDWG = swModel[/li]
[li]Set swDraw = swModel[/li]
[li]vSheetName = swDraw.GetSheetNames[/li]
[li]SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - 1))[/li]
[li]Set swModel = SWAPP.ACTIVEDOC[/li]
[li] Set swDraw = swModel[/li]
[li] Set swSheet = swDraw.GetCurrentSheet[/li]
[li] Set swSelMgr = swModel.SelectionManager[/li]
[li] Set swView = swDraw.GetFirstView[/li]
[li]Set swView = swView.GetNextView[/li]
[li] Set swModel = SWAPP.ACTIVEDOC[/li]
[li] Set SWDWG = swModel[/li]
[li][/li]
[li]SWDWG.ActivateSheet "SHEET TO DELETE"[/li]
[li]M = swView.ReferencedDocument.GetPathName[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]Dim MYView As Object[/li]
[li]Set MYiew = PART.CreateDrawViewFromModelView3(M, "*Front", 0.1097457655955, 0.1648856124764, 0)[/li]
[li]Set swModel = SWAPP.ACTIVEDOC[/li]
[li] Set SWDWG = swModel[/li]
[li] sSheetNames = SWDWG.GetSheetCount[/li]
[li]Set swSelMgr = swModel.SelectionManager[/li]
[li]Set swModel = SWAPP.ACTIVEDOC[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]boolstatus = PART.Extension.SelectByID2("DetailItem346@Sheet Format1", "NOTE", 0.4080223743143, -0.001548983140407, 0, False, 0, Nothing, 0)[/li]
[li]Set SWNOTE = swSelMgr.GetSelectedObject6(1, 0)[/li]
[li]Set swAnn = SWNOTE.GetAnnotation[/li]
[li]S = SWNOTE.GetText[/li]
[li]SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - 1))[/li]
[li]Set myDrawingSheet = PART.GetCurrentSheet()[/li]
[li]Set swDraw = swModel[/li]
[li]Set swSheet = swDraw.GetCurrentSheet[/li]
[li]myDrawingSheet.SetName "Sheet1"[/li]
[li]boolstatus = PART.Extension.SelectByID2("SET AUTHOR NAME & PROPERTY1", "SHEET", 0, 0, 0, False, 0, Nothing, 0)[/li]
[li]'part.DeleteSelection (False)[/li]
[li]If boolstatus = True Then GoTo 9[/li]
[li]boolstatus = SWAPP.RunMacro2("c:\SOLIDWORKS MACRO\DWG.swp", "MACROFEATURE_MODULE1", "main", swRunMacroUnloadAfterRun, nErrors)[/li]
[li]9 vSheetProps = swSheet.GetProperties[/li]
[li]'Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")[/li]
[li]'swCustPropMgr.Add2 "DOCTYPE", swCustomInfoText, " "[/li]
[li]'swCustPropMgr.Set "DOCTYPE", "$PRPSHEET" & ":" & Chr(34) & "DOCTYPE"""[/li]
[li]'Set part = swApp.ACTIVEDOC[/li]
[li]'S = swCustPropMgr.Get("DOCTYPE")[/li]
[li]If S = " " Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)[/li]
[li]If S = " " Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)[/li]
[li]If S = "" Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "ASSY-D_Orientech.slddrt", 0.4318, 0.2794, "Default", True)[/li]
[li]If S = "" Then boolstatus = PART.SetupSheet5("Sheet1", 12, 12, vSheetProps(2), vSheetProps(3), False, "PART-B_Orientech.slddrt", 0.4318, 0.2794, "Default", True)[/li]
[li]D = 2[/li]
[li]3 If sSheetNames = D Then GoTo 5[/li]
[li]SWDWG.ActivateSheet vSheetName(SheetCount - (SheetCount - D))[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]Set myDrawingSheet = PART.GetCurrentSheet()[/li]
[li]Set swDraw = swModel[/li]
[li]Set swSheet = swDraw.GetCurrentSheet[/li]
[li]vSheetProps = swSheet.GetProperties[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]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)[/li]
[li]If A = 1 Then A = 0[/li]
[li]'myDrawingSheet.SetName "Sheet" & D[/li]
[li] Dim bRet As Boolean[/li]
[li] Set SWAPP = CreateObject("SldWorks.Application")[/li]
[li] Set swModel = SWAPP.ACTIVEDOC[/li]
[li] Set swDraw = swModel[/li]
[li] Set swSheet = swDraw.GetCurrentSheet[/li]
[li] Set swView = swDraw.GetFirstView[/li]
[li] Debug.Print "File = " & swModel.GetPathName[/li]
[li] Debug.Print " " & swSheet.GetName[/li]
[li] While Not swView Is Nothing[/li]
[li] Debug.Print " " & swView.GetName2 & " [" & swView.Type & "]"[/li]
[li] Set swView = swView.GetNextView[/li]
[li][/li]
[li]While swView Is Nothing[/li]
[li]boolstatus = PART.Extension.SelectByID2("Sheet" & D, "SHEET", 0, 0, 0, False, 0, Nothing, 0)[/li]
[li]PART.DeleteSelection (False)[/li]
[li]A = 1[/li]
[li]GoTo 4[/li]
[li]Wend[/li]
[li]GoTo 4[/li]
[li] Wend[/li]
[li]4 D = D + 1[/li]
[li]GoTo 3[/li]
[li]5 'swDwg.ActivateSheet "SHEET TO DELETE"[/li]
[li]boolstatus = PART.Extension.SelectByID2("SHEET TO DELETE", "SHEET", 0, 0, 0, False, 0, Nothing, 0)[/li]
[li]PART.DeleteSelection (False)[/li]
[li]'part.EditDelete[/li]
[li] swModel.SummaryInfo(SwConst.swSumInfoAuthor) = "PAT LAFONTAINE"[/li]
[li]PARTTITLE2 = PART.GetTitle[/li]
[li][/li]
[li]SWAPP.CloseDoc PARTTITLE[/li]
[li] Set PART = SWAPP.ActivateDoc2(PARTTITLE2, 0, 0)[/li]
[li] 'PART.Save2 (silent)[/li]
[li]Set PART = SWAPP.ACTIVEDOC[/li]
[li]'Dim i As Integer[/li]
[li] ' Set SWAPP = Application.SldWorks[/li]
[li] ' SendKeys "%{F}" 'invoke file menu[/li]
[li] ' For i = 0 To 3 'go down to the saveas dialog[/li]
[li] ' SendKeys "{down}"[/li]
[li] ' Next i[/li]
[li] 'SendKeys "{enter}" 'enter[/li]
[li]longstatus = PART.SaveAs3(X, 0, 0)[/li]
[li]If swDocTypeLong = swDocDRAWING Then GoTo 11[/li]
[li]6 longstatus = PART.SaveAs3(X, 0, 0)[/li]
[li][/li]
[li]Set PART = Nothing[/li]
[li]Dim Answer3 As String[/li]
[li]Dim MyNote3 As String[/li]
[li] 'Place your text here[/li]
[li] MyNote3 = "DO YOU WISH TO CLOSE DOCUMENT?"[/li]
[li] 'Display MessageBox[/li]
[li] Answer3 = MsgBox(MyNote3, vbQuestion + vbYesNo, "???")[/li]
[li] If Answer3 = vbNo Then[/li]
[li] 'Code for No button Press[/li]
[li][/li]
[li] GoTo 10[/li]
[li] 'Code for Yes button Press[/li]
[li][/li]
[li] End If[/li]
[li]SWAPP.CloseDoc PARTTITLE[/li]
[li]GoTo 10[/li]
[li]11 Set PART = SWAPP.ACTIVEDOC[/li]
[li]PARTTITLE = PART.GetTitle[/li]
[li]Set PART = Nothing[/li]
[li]Dim Answer2 As String[/li]
[li]Dim MyNote2 As String[/li]
[li] 'Place your text here[/li]
[li] MyNote2 = "DO YOU WISH TO CLOSE DOCUMENT?"[/li]
[li] 'Display MessageBox[/li]
[li] Answer2 = MsgBox(MyNote2, vbQuestion + vbYesNo, "???")[/li]
[li] If Answer2 = vbNo Then[/li]
[li] 'Code for No button Press[/li]
[li][/li]
[li] GoTo 10[/li]
[li] 'Code for Yes button Press[/li]
[li][/li]
[li] End If[/li]
[li]SWAPP.CloseDoc PARTTITLE[/li]
[li]10 MsgBox "REFRESH DONE!" ' Define title.[/li]
[li]End[/li]
[li]End Sub[/li]
[/ul]thank you!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top