[综合讨论] Solidworks api另存为问题

 
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