|
- '把同一文件路径下之零件原单位 "克" 全部更新为 "公斤"
- '操作:
- '1. 把测试零件存在 c:test 之下.(何处皆可就是键入要对应),
- '2. 执行 宏 ,在提问窗体键入路径 c:test 按确认键就 ok
- Dim swApp As SldWorks.SldWorks
- Dim swModel As SldWorks.ModelDoc
- Dim Part As Object
- Dim sFileName As String
- Dim nFileName As String
- Dim path As String
- Dim nPath As String
- Dim nErrors As Long
- Dim nWarnings As Long
- Dim boolstatus As Boolean
-
- Sub main()
-
- Set swApp = Application.SldWorks
-
- path = InputBox("Enter a folder path containing any Solidworks files (For example ''c:test '' )", "Parts path location") '键输入路径
- sFileName = Dir(path & "*.sldprt") '?取出读档文件? *.sldasm or *.slddrw
- Do Until sFileName = ""
-
- Set swModel = swApp.OpenDoc6(path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings) '开档 swDocASSEMBLY or swDocDRAWING
- Set Part = swApp.ActiveDoc
- boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitSystem, 0, swUnitSystem_e.swUnitSystem_Custom) '设置单位为"自定"
- boolstatus = Part.Extension.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swUnitsMassPropMass, 0, swUnitsMassPropMass_e.swUnitsMassPropMass_Kilograms) '设置单位为“公斤”
- Part.ClearSelection2 True
- Set swModel = swApp.ActiveDoc
- swModel.Save '?存档
- swApp.CloseDoc swModel.GetTitle '开档
- Set swModel = Nothing
- sFileName = Dir '??取出读档名?
-
- Loop
- End Sub
复制代码
|
|