Solidworks api另存为问题
你好我有一个宏，从图纸中复制所有图纸，打开新模板并粘贴图纸。然后关闭旧图形并另存为与原始图形同名的新图形以覆盖它。
问题是粘贴完成后无法保存。它工作了一段时间，但不再有效，我什么也没改变。
你有什么想法吗？这是我的代码。。它与零件和装配部分配合良好。。非常感谢。
Dim vSheetName作为变体
将swView设置为SldWorks。看法
Dim swDraw作为SldWorks。绘图文档
Dim swAnn作为SldWorks。注释
将swSelMgr设置为SldWorks。SelectionMgr
将SWNOTE设置为SldWorks。注释
将S变暗为字符串
将swCustPropMgr设置为SldWorks。CustomPropertyManager
Dim SheetCount为整数
Dim DOC作为ModelDoc2
布尔型模糊布尔状态
Dim longstatus As Long，longwarnings As Long
将零件变暗为对象
Dim PARTTITLE作为字符串
尺寸X为字符串
公共Z作为字符串
公共Q作为字符串
Dim交换为SldWorks。SldWorks公司
Dim swModel作为ModelDoc2
昏暗的可怕的长
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
6longstatus = 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
页:
[1]