Continue to Site

Welcome to MCAD Central

Join our MCAD Central community forums, the largest resource for MCAD (Mechanical Computer-Aided Design) professionals, including files, forums, jobs, articles, calendar, and more.

SOLIDWORKS API SAVEAS PROBLEM

PATPOWER

New member
Hi,
I have a macro that copy all sheet from a drawing and open new template and paste the sheets on. Then close old drawing and saveas the new one with the same name of the original one to overwrite it.

The problem is that I cannot save after the paste is done. It works for a while but not anymore and I change nothing.

Do you have any ideas ? here my code..It works well with the part and assy section.. Thank you

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&n bsp; 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
 

Sponsor

Articles From 3DCAD World

Back
Top