×
INTELLIGENT WORK FORUMS
FOR ENGINEERING PROFESSIONALS

Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

SOLIDWORKS API SAVEAS3 PROBLEM

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.

  • 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
thank you!

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Resources