Jump to content

Solidworks api saveas problem

PATPOWER

By PATPOWER
in SolidWorks

 Share

Recommended Posts

PATPOWER Newbie

PATPOWER

Posted
Posted

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 - , "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
'Y = Mid(X, 1, Len(X) - 7) & "1" & Right(X, 7)
'PARTTITLE2 = PART.GetTitle

'SWAPP.CloseDoc PARTTITLE
'Set PART = SWAPP.ActivateDoc2(PARTTITLE2, 0, 0)

'longstatus = PART.SaveAs3(Y, 0, 0)
'PARTTITLE3 = PART.GetTitle
'SWAPP.CloseDoc PARTTITLE3
'Set swModel = SWAPP.OpenDoc6(Y, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, NWARNINGS)

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...