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!
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!