Dustry 发表于 2024-4-9 20:55:08

重命名零件和工程图(图纸升版本)

在论坛看到大佬 怕瓦落地2011 的帖子http://www.cmiw.cn/thread-1061682-1-1.html
代码:Dim swApp As Object
Dim Part As Object
Dim Error As Long
Dim Warning As Long
Dim mip As String
Dim Status As Boolean
Dim Newpath As String
Dim mipname As String
Dim vDepend() As String
    Sub main()
    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc
    Set swSelMgr = Part.SelectionManager
    Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
      swComp.SetSuppression2 (3)
    Set swSelModel = swComp.GetModelDoc2
    Set swSelModelext = swSelModel.Extension

    oldpathname = swComp.GetPathName

    Path = Left(oldpathname, InStrRev(oldpathname, "\")) '路径
    Debug.Print Path
    ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀
    Debug.Print ntype
    oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1) '旧文件名
    Debug.Print oldfi
    oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
         mipname = InputBox("changename", "name", oldname) '新文件名

         mip = Path & mipname & ntype '新文件名带路径
         Debug.Print mip

    If mip <> "" Then
         Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名(替换装配体中的原文件)
      Debug.Print Status
      '========================
      '更改工程图文件名
      Debug.Print Path
      tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
      Debug.Print tmpfi
      Do Until tmpfi = Null
      tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "\") + 1)
      Debug.Print tmpfiname
      tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
      Debug.Print tmpoldname
      If tmpfiname = tmpoldname Then '查找同名工程图
      newdrwname = Path & mipname & ".SLDDRW"
      Debug.Print newdrwname
      olddrwname = Path & tmpfi
      FileCopy olddrwname, newdrwname '复制工程图到新文件夹
      vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖

      Debug.Print vDepend(1)
      bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖

      Debug.Print bl
         Exit Do
       End If
    tmpfi = Dir
    Debug.Print tmpfi
    Loop
    End If
    End Sub

试了下这个宏(本人用的SW2018)报错:
对象不支持这个属性或方法(错误 438)
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)'更改零件文件名(替换装配体中的原文件)
有哪位大佬能帮解答一下吗?是不是SaceAs3语句的问题?

Lean_2017.feng 发表于 2024-4-10 09:40:15

以下方法说明,请自行测试:

'Usage
IModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)


'Func Declaration
Function SaveAs3( _
   ByVal Name As System.String, _
   ByVal Version As System.Integer, _
   ByVal Options As System.Integer, _
   ByVal ExportData As System.Object, _
   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
   ByRef Warnings As System.Integer _
) As System.Boolean

Parameters
    Name
      Full pathname of the document to save; the file extension indicates any conversion that should be performed (for example, Part1.igs to save in IGES format) (see Remarks)
    Version
      Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
    Options
      Option indicating how to save the document as defined in swSaveAsOptions_e (see Remarks)
    ExportData
      IExportPdfData object for exporting drawing sheets to PDF (see Remarks)
    AdvancedSaveAsOptions
      IAdvancedSaveAsOptions (see Remarks)
    Errors
      Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
    Warnings
      Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
Return Value
    True if the save is successful, false if not


内容摘自apihelp.chm(通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ )




页: [1]
查看完整版本: 重命名零件和工程图(图纸升版本)