solidworks批量換工程圖圖框的VBA代碼

慕容攬月

第一步：將后綴為“.slddrt”的圖紙格式文件放入此文件夾內(nèi)，此圖紙格式文件是自己需要的新圖框。
第二步：將要替換模板的文件放入一個文件夾，將文件夾地址粘貼到相應(yīng)的地方（程序中有備注）
; X% s) E) f. l6 T5 L6 b& f* q) _第三步：用宏命令運行程序：
. d- w* F' e# y, q+ ~
第一步的附圖：
2 J& u  b% }$ a. H  ^+ i" l
程序：
' ******************************************************************************
' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
* {2 ]) m4 {3 S" R; e' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean


9 S' a$ z0 y. ?* i8 B* C


Dim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer
7 o, [4 F1 W$ h, N
Sub Main()
0 j' i$ L2 x: }% n5 [4 _- Q' [


Set swApp = _
' ^8 N. h* Q2 B" ^Application.SldWorks
3 g( m! B( ^$ Y) vmyPath = "C:\Users\Administrator\Desktop\新建文件夾 (2)\" '把文件路徑定義給變量，第二步中的路徑填到此處。
myFile = Dir(myPath & "*.slddrw") '依次找尋指定路徑中的*.文件
. P+ g! `' U9 C4 Ni = 0
% s6 J; ]1 ], r1 q( k# ?Do While myFile <> ""
1 F& g7 a% [- N. W/ S2 m8 L% aSet Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)
" K6 a- u) L4 S. g- T! z% @+ J
Set Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
' U; c9 ?5 t! z* P& c; x( QSheetName = Drawing.GetSheetNames
SheetCount = Drawing.GetSheetCount
For i = 0 To SheetCount - 1
7 c) y1 {9 j+ v% j" N1 ]9 i( n% q    Drawing.ActivateSheet SheetName(i)
% [: U8 P  C9 ?2 l% |2 \    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
6 B  T* I6 s0 ]    swTemplatePath = Split(swTemplate, "")
    swTemplate = swTemplatePath(UBound(swTemplatePath))
- y! d* B7 y7 ]9 q9 z8 K1 o6 D    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
: [' U8 \0 G5 `7 ~. j9 c    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 0, 0, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", 1, 1, ""
& e- Z4 R+ k- i) I8 B+ G0 [    Drawing.SetupSheet4 Drawing.GetCurrentSheet.GetName, 12, 12, vSheetProps(2), vSheetProps(3), vSheetProps(4), swTemplate, 0, 0, ""
# k* z+ }+ m- ~: |/ X+ D; [5 G    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
Next
& h- l, b8 v" f2 f) rDrawing.ActivateSheet RetoreSheetName

Part.Save
* ?* _) Q/ O- |& V- VswApp.CloseDoc myPath & myFile
. ]8 u8 v6 z. h& q1 x
myFile = Dir '找尋下一個*.文件

Loop

End Sub

ィ心兂鎅

感謝

遠祥

這種騷操作不用插件就能實現(xiàn)？

925269815

有時間試試看，感謝

hdgd501

好強大，謝謝樓主！！！

零度freedom

樓主，有沒有批量導(dǎo)入展開圖的VBA，像圖片這樣的
: s& }/ p! P' k5 v" J或者鈑金方面批量處理的VBA，比如批量改折彎系數(shù) 批量歸類不同板厚零件的

nolility

可以在solid works設(shè)置實現(xiàn)嗎

念天悠

感謝，學(xué)習(xí)了

mg172

宏內(nèi)部能否指定（圖紙格式文件），現(xiàn)在運行宏，顯示要選擇圖紙格式文件，能否不要互動窗口，直接指定某個文件進行替換

眸上有傷痕

學(xué)習(xí)學(xué)習(xí)