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

慕容攬?jiān)?/a>

第一步：將后綴為“.slddrt”的圖紙格式文件放入此文件夾內(nèi),，此圖紙格式文件是自己需要的新圖框,。
第二步：將要替換模板的文件放入一個(gè)文件夾,，將文件夾地址粘貼到相應(yīng)的地方（程序中有備注）
第三步：用宏命令運(yùn)行程序：

* `/ a' S; m$ N* V% G第一步的附圖：
  X& x6 v6 o6 l- i6 d# @7 @/ l
程序：
8 E! U* R3 K0 I8 M6 l: x' ******************************************************************************
' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
' ******************************************************************************
Dim swApp As Object
) o4 ^# v2 @% b, L$ }5 ?
, D/ e/ W. i! x' Y8 F& ^) d4 @Dim Part As Object
Dim boolstatus As Boolean
/ l4 r- b& M2 m# d% `

# |0 T( @6 c! B* U, k( h' c9 J' m
! C6 l0 W6 m, R0 L4 ~6 u! x  _

9 t3 n1 `2 Z+ t" }0 SDim longstatus As Long, longwarnings As Long, myPath$, myFile$
: t: D- n- r  I+ s: v% ODim i As Integer

( d; P5 j4 A, k5 a: Y( m( J" u7 c7 lSub Main()



Set swApp = _
) C* w  R( ~+ cApplication.SldWorks
5 y) L! |* Z, U% k, |8 bmyPath = "C:\Users\Administrator\Desktop\新建文件夾 (2)\" '把文件路徑定義給變量,，第二步中的路徑填到此處,。
* T, Z8 {  o+ ImyFile = Dir(myPath & "*.slddrw") '依次找尋指定路徑中的*.文件
i = 0
( J; f: o: p% v% _" D5 X% gDo While myFile <> ""
1 n& {8 d5 W$ r  k3 Z' ]9 `" O1 jSet Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)

Set Drawing = swApp.ActiveDoc
; i$ B8 M! i1 A+ m1 C. D4 D% dIf Drawing.GetType <> 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
6 m9 }/ C/ R4 y- I. ^% O/ l1 {% nSheetCount = Drawing.GetSheetCount
/ t: O! b7 ]8 GFor i = 0 To SheetCount - 1
    Drawing.ActivateSheet SheetName(i)
    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
    swTemplatePath = Split(swTemplate, "")
    swTemplate = swTemplatePath(UBound(swTemplatePath))
    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
  Z: Y! g/ Q7 b$ G7 C; ]5 b    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, ""
: T( t$ l. [, Z( ~5 P" A    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
% u' g$ b& J% V: c4 O$ \% f9 gNext
" I1 @% V+ }) u. `8 v8 qDrawing.ActivateSheet RetoreSheetName
4 L/ p. z; k+ G% A  f' t8 d9 S
Part.Save
$ O  T2 a% H' g# `) s1 s9 |swApp.CloseDoc myPath & myFile
# K7 i5 L, s) S) _
myFile = Dir '找尋下一個(gè)*.文件

Loop

5 y, p* ~* z/ [3 G. D3 |% uEnd Sub

ィ心兂鎅

感謝

遠(yuǎn)祥

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

925269815

有時(shí)間試試看,，感謝

hdgd501

好強(qiáng)大,，謝謝樓主！�,�,！

零度f(wàn)reedom

樓主，有沒(méi)有批量導(dǎo)入展開(kāi)圖的VBA,，像圖片這樣的
  }: `4 F) o% Y3 r; ^7 q  u或者鈑金方面批量處理的VBA,，比如批量改折彎系數(shù) 批量歸類不同板厚零件的
) x' y( F) }2 y+ V3 ]. ~5 V

nolility

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

念天悠

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

mg172

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

眸上有傷痕

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