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

慕容揽月

第一步：将后缀为“.slddrt”的图纸格式文件放入此文件夹内，此图纸格式文件是自己需要的新图框。
8 e, J" k- X0 U6 E# M+ m: c" a) R第二步：将要替换模板的文件放入一个文件夹，将文件夹地址粘贴到相应的地方（程序中有备注）
1 c1 v6 O& w& C5 n9 F, B6 ~第三步：用宏命令运行程序：
5 J# o9 B$ b, E8 I& I
6 _% B" p6 n# \8 b4 z" M8 E! b第一步的附图：

, `5 H& f9 P9 F! P程序：
+ T( i9 v0 v" x) D* ]' ******************************************************************************
' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
- J4 Z5 T  m' R5 A$ J2 c' P' ******************************************************************************
% n) d' n6 X* y9 H; ]Dim swApp As Object

  U+ N  ^" |9 ]8 eDim Part As Object
2 t# P9 i2 q# r4 ?- H8 t$ VDim boolstatus As Boolean
7 E: E2 ^* `" f+ t/ j7 X5 h" c
7 Z+ ^! v/ M1 L! m! P6 P/ V3 L
/ l, P; b8 U  I/ Q, R' Z; w4 l
: J: J: T5 X2 N
* i* u* }. c8 P
Dim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer

Sub Main()
- [# ?  q8 M  ^. D% L9 s1 b

# d. N/ c8 o* M$ c
% s; a; a. u3 M) X) O5 z) WSet swApp = _
6 o4 ~0 Q" L) R2 t6 O* LApplication.SldWorks
' q' i+ {( [6 Y0 j3 C- v0 k+ }myPath = "C:\Users\Administrator\Desktop\新建文件夹 (2)\" '把文件路径定义给变量，第二步中的路径填到此处。
0 \% P$ Z0 t: a( TmyFile = Dir(myPath & "*.slddrw") '依次找寻指定路径中的*.文件
i = 0
: X& G8 Z5 b2 qDo While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)
/ M; U' C3 C3 S4 [1 Z4 q$ j& E- B
% ^, s3 C6 d( o- MSet Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
/ y. L1 I+ l; ^4 ORetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
. `8 b7 e+ S2 B8 `SheetCount = Drawing.GetSheetCount
/ z( w; l; s# h3 g( o7 Z, Z% DFor i = 0 To SheetCount - 1
0 W& d2 M% Z0 {/ j! h/ i    Drawing.ActivateSheet SheetName(i)
    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
    swTemplatePath = Split(swTemplate, "")
    swTemplate = swTemplatePath(UBound(swTemplatePath))
$ S# p1 C& w! ?5 z+ Z& `    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
. g# M* x3 a- [    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()
: U6 i9 O. H0 q4 UNext
8 @, s7 y: T+ mDrawing.ActivateSheet RetoreSheetName

Part.Save
swApp.CloseDoc myPath & myFile
6 i) \9 p5 t# a$ T, v1 R2 |
myFile = Dir '找寻下一个*.文件
7 ^' s* E% e$ }8 r
Loop

End Sub

ィ心兂鎅

感谢

远祥

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

925269815

有时间试试看，感谢

hdgd501

好强大，谢谢楼主！！！

零度freedom

楼主，有没有批量导入展开图的VBA，像图片这样的
或者钣金方面批量处理的VBA，比如批量改折弯系数 批量归类不同板厚零件的
3 H7 l/ d! i2 s* N, r$ T7 w0 `1 @

nolility

可以在solid works设置实现吗

念天悠

感谢，学习了

mg172

宏内部能否指定（图纸格式文件），现在运行宏，显示要选择图纸格式文件，能否不要互动窗口，直接指定某个文件进行替换

眸上有伤痕

学习学习