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

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

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

第一步的附圖：

程序：
' ******************************************************************************
1 O4 d1 i4 m4 R, k' C:\Users\Administrator\AppData\Local\Temp\swx8592\Macro1.swb - macro recorded on 06/26/19 by Administrator
! q  ]: }% [  z' ******************************************************************************
Dim swApp As Object

( h3 _( p" F$ M0 {Dim Part As Object
Dim boolstatus As Boolean





6 s& ]$ y/ o. x  B4 TDim longstatus As Long, longwarnings As Long, myPath$, myFile$
Dim i As Integer
) _  D6 F: {( E* r+ @
' w1 m9 Y; ]1 N8 M5 ^& XSub Main()

2 f! \. l- T8 H$ t% P% e1 V9 P

Set swApp = _
Application.SldWorks
% l$ a3 ^$ h0 u# U; t3 WmyPath = "C:\Users\Administrator\Desktop\新建文件夾 (2)\" '把文件路徑定義給變量，第二步中的路徑填到此處,。
- }  q/ L* E' h  d) [% nmyFile = Dir(myPath & "*.slddrw") '依次找尋指定路徑中的*.文件
i = 0
8 p- G# h- @% F' j% G8 YDo While myFile <> ""
Set Part = swApp.OpenDoc6(myPath & myFile, 3, 0, "", longstatus, longwarnings)
) V* n1 F6 \' u- b3 A* a
  {+ `6 h& T8 O) K% eSet Drawing = swApp.ActiveDoc
If Drawing.GetType <> 3 Then Exit Sub
RetoreSheetName = Drawing.GetCurrentSheet.GetName
SheetName = Drawing.GetSheetNames
SheetCount = Drawing.GetSheetCount
For i = 0 To SheetCount - 1
+ N6 S' @+ V. f: H    Drawing.ActivateSheet SheetName(i)
    swTemplate = Drawing.GetCurrentSheet.GetTemplateName
7 f. {6 ?% @7 }, w7 b* _, X' _    swTemplatePath = Split(swTemplate, "")
# N- z. j. S$ I" `    swTemplate = swTemplatePath(UBound(swTemplatePath))
6 }" G; K' }% z$ u    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
    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, ""
$ E' k2 S$ i- o, @    vSheetProps = Drawing.GetCurrentSheet.GetProperties()
Next
. ]6 S( e5 {- u5 e* n" rDrawing.ActivateSheet RetoreSheetName
# @5 u* F- f. S
. B5 m+ Z6 i& p, e1 f' B1 r! APart.Save
' ]. {0 a) _$ T# E5 ?/ T" z6 LswApp.CloseDoc myPath & myFile

myFile = Dir '找尋下一個(gè)*.文件
, }, p* }6 o$ z+ {
Loop

End Sub

ィ心兂鎅

感謝

遠(yuǎn)祥

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

925269815

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

hdgd501

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

零度freedom

樓主,，有沒有批量導(dǎo)入展開圖的VBA，像圖片這樣的
或者鈑金方面批量處理的VBA,，比如批量改折彎系數(shù) 批量歸類不同板厚零件的
6 M% V4 P6 s8 V  L- y) G2 p0 D. W

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í)