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

慕容揽月

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

第一步的附图：
% D7 P" ]4 ?! y( t( |0 G: r
程序：
' ******************************************************************************
6 l5 s  E- t8 `2 Z2 ^' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
2 H) m% I7 W2 [( J1 X' ******************************************************************************
' o, |  x  i! R, j/ {% jDim swApp As Object
$ [- e! \0 Z9 n' y+ c0 I5 y9 R! k: l
2 O* v% g$ K1 J8 bDim Part As Object
Dim boolstatus As Boolean

# p+ k% @- X4 a. ~& k
5 ]% q0 l& n' m+ m0 z
& G7 N! [* w( B0 N/ M9 u

& a: E0 @3 c0 j6 y1 }" J) Q6 DDim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer

; O5 z( y& P( [* ~Sub Main()
* g  s# p$ R* q6 q+ R

, S2 ^+ P2 S7 {4 J* U" V
! V, ], h% N. `! n1 A/ kSet swApp = _
+ @: T3 R) k/ j; ^4 S8 s4 g! q+ jApplication.SldWorks
( V! u+ D$ P$ J( o! smyPath = "C:\Users\Administrator\Desktop\新建文件夹 (2)\" '把文件路径定义给变量，第二步中的路径填到此处。
0 {! j$ R& c( A, P" Q* P$ @! hmyFile = Dir(myPath & "*.slddrw") '依次找寻指定路径中的*.文件
" x# i9 a4 `% M  v( fi = 0
Do While myFile <> ""
$ i. |% N3 e, U/ j8 G" ~$ V- x8 JSet Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)

% q" R% v. X+ S4 FSet Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
# z7 Y$ z; b$ x8 [! QSheetName = Drawing.GetSheetNames
  \6 h# @* i$ u5 `SheetCount = Drawing.GetSheetCount
1 X4 F7 D' s2 M3 y+ ^2 qFor i = 0 To SheetCount - 1
    Drawing.ActivateSheet SheetName(i)
' V. k0 b# g9 z    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
+ C' d6 F6 c, U( T" }* f# M    swTemplatePath = Split(swTemplate, "")
2 A: m% E8 s* _! I# r6 f    swTemplate = swTemplatePath(UBound(swTemplatePath))
, ~# S7 v6 t3 H" A$ \- b# l% ^    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
0 R5 ^( ]. v3 d0 m* D# \: G1 _9 H, \    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()
4 J& n) @2 D( e- t( YNext
& z, x2 E  P! s% Q+ ?Drawing.ActivateSheet RetoreSheetName

Part.Save
7 {0 w$ p( i) {5 {9 A% @- [  bswApp.CloseDoc myPath & myFile
) G, G2 Y* ~6 x$ `/ H0 f7 T
6 P2 W  k7 U2 Z' _7 `# O8 t$ DmyFile = Dir '找寻下一个*.文件
- c* b, t) i+ F7 F4 J: H
( @  v$ \( i' f# ^$ zLoop

7 U, c$ b4 y. p/ Z5 k( ]End Sub

ィ心兂鎅

感谢

远祥

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

925269815

有时间试试看，感谢

hdgd501

好强大，谢谢楼主！！！

零度freedom

楼主，有没有批量导入展开图的VBA，像图片这样的
$ C0 O* E$ _: k. I  U" p" j3 X  W6 h/ }或者钣金方面批量处理的VBA，比如批量改折弯系数 批量归类不同板厚零件的

nolility

可以在solid works设置实现吗

念天悠

感谢，学习了

mg172

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

眸上有伤痕

学习学习