批量更换图纸格式代码的问题？

Rve_est

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swFilename As String
Dim swDraw As SldWorks.DrawingDoc
Dim swSheet As SldWorks.Sheet
Dim bRet As Boolean
Dim sPath As String
Dim nErrors As Long
Dim nWarnings As Long
Dim Response As String
Dim DocName As String
' Change sheet format location here
Public Const sTemplatePath As String = "D:solidworks模板要更换图纸格式"
Sub main()
Set swApp = Application.SldWorks
' Change folder location containing the drawings to be updated here
SheetFormat "D:SolidWorks模板要更换图纸", ".SLDDRW", True
End Sub
Sub SheetFormat(folder As String, ext As String, silent As Boolean)
Dim swDocTypeLong As Long
ext = UCase$(ext)
swDocTypeLong = Switch(ext = ".SLDDRW", swDocDRAWING, True, -1)
'If not a SW file, return
If swDocTypeLong = -1 Then
Exit Sub
End If
ChDir (folder)
Response = Dir(folder)
Do Until Response = ""
swFilename = folder & Response
If Right(UCase$(Response), 7) = ext Then
Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)
If swDocTypeLong = swDocDRAWING Then
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
' Change Sheet format name here which you to put on the drawing sheet.
sPath = sTemplatePath & "A3-b.slddrt"
bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, 1, 1, True, sPath, 0.2794, 0.2159, "Default")
End If
swModel.ViewZoomtofit2
swModel.ForceRebuild3 False
swModel.Save2 silent
swApp.CloseDoc swModel.GetTitle
End If
Response = Dir
Loop
MsgBox "Drawing(s) Sheet Fomat Updated!!"
End Sub
换了 格式 还是 第三视角的 不是我们用第一视角的 这个我改过来
为什么更换 后 轴测图 比例变了 怎么改代码不让他变？？？ 谢谢大家了

zhumin0377

由于目前本人是菜鸟级，故不能发贴。但我本人是名SW二次开发爱好者，真心想结交一些志同道合的朋友，共同学习开发上的难题与技巧。目前我已开发了部分宏，例：
批量文件夹零件模型生成展开料.SWP
批量文件夹打印.swp,
批量换图纸格式.swp,
批量修改自定义属性.swp
在此我只想与有共同爱好的朋友交流学习，共同进步！
欢迎加我的QQ：342061880，也可以加我的群： 451984398
在此申明：仅学习交流。

电脑--小陈

请大家 帮我看看 怎么改啊  谢谢了

永遇乐遇永乐

请版主 帮忙啊  高手  指导一下 ？ 谢了

@旭@

   经典案例图书

我顶上去

pushaowei

Sub 工程图换图框()
If Dir(指定路径 & "" & 文件名 & ".sldprt", vbHidden + vbReadOnly + vbSystem) = "" And _
   Dir(指定路径 & "" & 文件名 & ".sldasm", vbHidden + vbReadOnly + vbSystem) = "" Then
缺模型数量 = 缺模型数量 + 1
xlsheet.RANGE("B" & i + 2).Value = "无模型"
xlsheet.RANGE("A" & i + 2).Interior.Color = vbYellow
Exit Sub
End If
'On Error Resume Next
'
Set swApp = CreateObject("sldworks.application")
Set Part = swApp.ActiveDoc
Set Part = swApp.OpenDoc6(指定路径 & "" & strPath, 3, 0, "", longstatus, longwarnings)  ''打开返回值 strpath的SW文件
Set 当前页面 = Part.GetCurrentSheet
图纸属性 = 当前页面.GetProperties
图纸名称 = 当前页面.GetName
模板后缀 = ".slddrt"
If 图纸属性(5) * 1000 = 210 And 图纸属性(6) * 1000 = 297 Then
  幅面 = "A4"
  ElseIf 图纸属性(5) * 1000 = 420 And 图纸属性(6) * 1000 = 297 Then
   幅面 = "A3"
   ElseIf 图纸属性(5) * 1000 = 594 And 图纸属性(6) * 1000 = 420 Then
    幅面 = "A2"
    ElseIf 图纸属性(5) * 1000 = 841 And 图纸属性(6) * 1000 = 594 Then
     幅面 = "A1"
     ElseIf 图纸属性(5) * 1000 = 1189 And 图纸属性(6) * 1000 = 841 Then
      幅面 = "A0"
End If
If Dir(指定路径 & &quot;&quot; & 文件名 & &quot;.sldprt&quot;, vbHidden + vbReadOnly + vbSystem) <> &quot;&quot; Then
新模板名称 = 幅面 & 模板后缀
ElseIf Dir(指定路径 & &quot;&quot; & 文件名 & &quot;.sldasm&quot;, vbHidden + vbReadOnly + vbSystem) <> &quot;&quot; Then
新模板名称 = 幅面 & &quot;(装)&quot; & 模板后缀
End If
'Part.EditTemplate
'Part.EditSketch
'Part.ClearSelection2 True
'Part.EditSheet
'Part.EditSketch
Part.ClearSelection2 True
boolstatus = Part.SetupSheet5(图纸名称, 图纸属性(0), 图纸属性(1), 图纸属性(2), 图纸属性(3), 图纸属性(4), 新模板名称, 图纸属性(5), 图纸属性(6), &quot;默认&quot;, True)
longstatus = Part.SaveAs3(文件名 & &quot;.slddrw&quot;, 0, 0)
swApp.CloseDoc 指定路径 & &quot;&quot; & 文件名 & &quot;.slddrw&quot;
'On Error GoTo 0
完成数量 = 完成数量 + 1
End Sub
我的已经编好了
发一段关键代码，你可以参考一下。

edakyvet

   经典案例图书

谢谢 相互学习一下

xszki

好东西

wangyanpin

bRet = swDraw.SetupSheet4(swSheet.GetName, swDwgPaperAsize, swDwgTemplateCustom, 1, 1, True, sPath, 0.2794, 0.2159, "Default")，这条命令的问题。swSheet.GetName,为工程图纸的名称（非工程图的名称），swDwgPaperAsize为原图纸尺寸，swDwgTemplateCustom为原图纸图框尺寸，1, 1,为现在图纸比例，0,0的话保持原来的不变，sPath，为新模板名称，0.2794, 0.2159, 为新图纸的尺寸，一般要和新模板的尺寸一直。"Default"为配置。要写比例不变，把1, 1,变为0,0。