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

慕容揽月

第一步：将后缀为“.slddrt”的图纸格式文件放入此文件夹内，此图纸格式文件是自己需要的新图框。
7 r$ Y& B' m) b" s- E( j第二步：将要替换模板的文件放入一个文件夹，将文件夹地址粘贴到相应的地方（程序中有备注）
( ?0 \# {# `" J5 ]( u第三步：用宏命令运行程序：

第一步的附图：
& ?3 ^' A! B# i2 c; r
程序：
- p# E+ W! z2 |! h5 K' Q$ W: R/ `' ******************************************************************************
' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
5 _6 L7 m. [+ T( t! f2 u  T7 d% q' ******************************************************************************
Dim swApp As Object
' \! I- K7 e; T. w
4 G4 B. m. G3 q$ BDim Part As Object
Dim boolstatus As Boolean

) P4 ~* W/ j9 t, n+ {" O: r, c


0 v3 h# i2 p- @1 N5 m2 G0 E
, _6 L2 n) E. u8 T8 }+ pDim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer
% W+ O" c1 A; j3 P( ^
% \5 _& m8 J/ A# {2 V9 KSub Main()

. T- I$ q- Y; A6 `' m0 h8 C. W9 n! F

5 D! Q7 [, i+ U% h/ ~' zSet swApp = _
7 Y5 H+ ]* f/ Z7 }8 N* X" w. HApplication.SldWorks
! H4 z$ y' [& q$ ?1 g) MmyPath = "C:\Users\Administrator\Desktop\新建文件夹 (2)\" '把文件路径定义给变量，第二步中的路径填到此处。
myFile = Dir(myPath & "*.slddrw") '依次找寻指定路径中的*.文件
: o0 Q+ d& ?& bi = 0
6 d% l$ K" _, R; h5 H. LDo While myFile <> ""
0 g& j. u9 e0 Z2 ?6 _7 g2 ]Set Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)

5 b+ P8 c: _1 `0 b  T! g  {) k5 f5 MSet Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
# x: X; X3 K) j  I: Y, m& TRetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
; p4 m4 k  D0 p) a& o0 A5 M/ @SheetCount = Drawing.GetSheetCount
) w0 z- a7 F  R$ ?" t: `3 ]For i = 0 To SheetCount - 1
  t$ G8 L, f. E) V' X. V* [8 S7 L    Drawing.ActivateSheet SheetName(i)
- s2 A8 r5 Q2 Y0 z8 D' t* u    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
* _, x+ T6 ?; n1 S# `    swTemplatePath = Split(swTemplate, "")
5 s0 l* G% Y; {# t$ o& A* r    swTemplate = swTemplatePath(UBound(swTemplatePath))
    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
% p! M3 }4 |& |    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 0, 0, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", 1, 1, ""
1 U7 V7 r  M1 p. R0 `6 |% d/ o    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 12, 12, vSheetProps(2), vSheetProps(3), vSheetProps(4), swTemplate, 0, 0, ""
6 ~2 w/ h. j8 o6 V1 W& U, C    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
1 r0 s2 Y: U$ h/ |+ `Next
Drawing.ActivateSheet RetoreSheetName

0 c9 J: H/ ]1 U6 H0 O! }Part.Save
swApp.CloseDoc myPath & myFile
2 D- N/ @8 w- p' t, S8 A
6 E3 y" X8 i! {3 T' ^' L& X! V, UmyFile = Dir '找寻下一个*.文件
, n! u: h6 i$ R, S! G% ^
Loop
- Z) w' x6 H0 K& p
End Sub

LYY-XXM

不明觉厉，我都是一张张替换的

DLKS

感谢大佬，前来学习

baiqvcel

感谢楼主无私奉献！ 大神！

眸上有伤痕

学习学习

mg172

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

念天悠

感谢，学习了

nolility

可以在solid works设置实现吗

零度freedom

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

hdgd501

好强大，谢谢楼主！！！