solidworks批量换工程图图框的VBA代码

liedword · 发表于 2019-6-27 04:34:55

第一步：将后缀为“.slddrt”的图纸格式文件放入此文件夹内，此图纸格式文件是自己需要的新图框。
第二步：将要替换模板的文件放入一个文件夹，将文件夹地址粘贴到相应的地方（程序中有备注）
第三步：用宏命令运行程序：

第一步的附图：

程序：
' ******************************************************************************
' C:UsersAdministratorAppDataLocalTempswx8592Macro1.swb - macro recorded on 06/26/19 by Administrator
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer

Sub Main()

Set swApp = _
Application.SldWorks
myPath = "C:UsersAdministratorDesktop新建文件夹 (2)" '把文件路径定义给变量，第二步中的路径填到此处。
myFile = Dir(myPath & "*.slddrw") '依次找寻指定路径中的*.文件
i = 0
Do While myFile ""
Set Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)

Set Drawing = swApp.ActiveDoc
If Drawing.GetType 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
SheetCount = Drawing.GetSheetCount
For i = 0 To SheetCount - 1
Drawing.ActivateSheet SheetName(i)
swTemplate = Drawing.GetCurrentSheet.GetTemplateName
swTemplatePath = Split(swTemplate, "")
swTemplate = swTemplatePath(UBound(swTemplatePath))
vSheetProps = Drawing.GetCurrentSheet.GetProperties()
Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 0, 0, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", 1, 1, ""
Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 12, 12, vSheetProps(2), vSheetProps(3), vSheetProps(4), swTemplate, 0, 0, ""
vSheetProps = Drawing.GetCurrentSheet.GetProperties()
Next
Drawing.ActivateSheet RetoreSheetName

Part.Save
swApp.CloseDoc myPath & myFile

myFile = Dir '找寻下一个*.文件

Loop

End Sub

xxd2756 · 发表于 2019-6-28 16:44:20

感谢

jemin1981 · 发表于 2019-6-29 00:25:12

这种骚操作不用插件就能实现？

lt8206 · 发表于 2019-6-29 01:27:39

有时间试试看，感谢

zjkzzw · 发表于 2019-6-29 05:36:07

经典案例图书

好强大，谢谢楼主！！！

wwdvictor · 发表于 2019-6-30 14:29:40

楼主，有没有批量导入展开图的VBA，像图片这样的
或者钣金方面批量处理的VBA，比如批量改折弯系数批量归类不同板厚零件的

sport8888 · 发表于 2019-6-30 22:50:17

经典案例图书

可以在solid works设置实现吗

wwwerzhou · 发表于 2022-5-17 18:59:37

楼主太有才了，膜拜中……

hnymzb · 发表于 2022-5-18 14:32:56

solidworks批量换工程图图框的VBA代码

macowe · 发表于 2022-5-25 09:20:54

宏有问题，老大们怎么解决呀

Andwenzi · 发表于 2022-5-29 16:51:02

macowe 发表于 2022-5-25 09:20
宏有问题，老大们怎么解决呀

是不是少空格了

wscgb123 · 发表于 2022-6-2 23:21:40

楼主辛苦了！

jiedahuanxi · 发表于 2023-8-1 00:21:16

Sub Main222()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim myPath As String, myFile As String
Dim i As Integer
Dim a As Integer
Dim k As Integer
k = 0

Set swApp = Application.SldWorks
'myPath = "C:\Users\Administrator\Desktop\888\02" '将文件路径定义给变量
myPath = InputBox("请输入图纸文件夹路径:", "文件夹路径")
mblj = InputBox("请输入工程图模版文件夹路径:", "文件夹路径")
'如"C:\Users\Administrator\Desktop\888\02\000A4.slddrt"路径要包括模板名字+后缀，并且前后都要有英文版的双引号。
a = InputBox("请输入处理几个文件:", "文件夹路径")
'只能输入整数，表示处理几个文件


myFile = Dir(myPath & "\*.SLDDRW") '首次找寻指定路径中的*.文件

Do While myFile <> ""
      Set Part = swApp.OpenDoc6(myPath & "\" & myFile, 3, 0, "", longstatus, longwarnings)
      k = k + 1

      '在这里添加对文件的处理代码
      boolstatus = Part.SetupSheet5("Sheet1", 12, 12, 1, 5, True, mblj, 0.297, 0.21, "默认", True)
   ' MsgBox "测试一下"


      Part.Save
      swApp.CloseDoc myPath & "\" & myFile

      myFile = Dir '重置文件指针，以便下一次迭代可以找到下一个文件
      If k = a Then Exit Sub
Loop
End Sub

独狼K123456 · 发表于 2023-12-6 09:11:15

楼主辛苦了！

		自动登录	找回密码
密码			立即注册

solidworks批量换工程图图框的VBA代码

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献