iCAx开思网

标题: 用宏半自动输出 DXF 时，文件名的变量是什么呢 [打印本页]
作者: jujue    时间: 2017-2-7 11:20
标题: 用宏半自动输出 DXF 时，文件名的变量是什么呢
本帖最后由 jujue 于 2017-2-8 17:49 编辑

小弟在工作中经常需要把工程图转成DXF 方便线切割用
于是自己录制了一个宏
---------------------------------------------
' ******************************************************************************
' C:\TEM\swx3212\Macro1.swb - macro recorded on 04/14/15 by Administrator
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
longstatus = Part.SaveAs3("C:\Users\YZ01\Desktop\TX.DXF", 0, 0)
End Sub

-----------------------------------------
并且设置了宏按钮
[attach]1244903[/attach]

这样可以自动在桌面保存一个TX.DXF的文件

现在想做个升级版
每次保存的文件名是SW的文件名+图纸名称
类似于
PunchID&SW-图纸名称(Sheet Name)

因为小弟不懂二次开发，请高手帮忙修改下
谢谢了

作者: qiminger    时间: 2017-2-7 12:47
本帖最后由 qiminger 于 2017-2-7 12:49 编辑

在代码：Set Part = swApp.ActiveDoc下一段插入：

Dim swModelName As String
Dim FileName As String
Dim i As Integer

swModelName = Part.GetPathName      '读取当前SW模型文档名(含路径)

i = InStrRev(swModelName, "\")'取"\"字符位置
FileName = Mid(swModelName, i + 1, Len(swModelName) - i)'取出文件名包含后缀
FileName = Left(FilePath, Len(FilePath) - 7)'取文件名，去后缀

...

在保存文件代码适当位置加入"" & FileName & ""

附件为txt文本文件，方便复制
[attach]1244905[/attach]
作者: jujue    时间: 2017-2-7 15:29
qiminger 发表于 2017-2-7 12:47
在代码：Set Part = swApp.ActiveDoc下一段插入：

Dim swModelName As String

[attach]1244912[/attach]
修改后不能自动输出了， 逐语句调试到这里 报错，菜鸟不懂是什么问题，高手能指正下吗？
作者: qiminger    时间: 2017-2-7 16:25
本帖最后由 qiminger 于 2017-2-7 16:31 编辑
jujue 发表于 2017-2-7 15:29
修改后不能自动输出了， 逐语句调试到这里 报错，菜鸟不懂是什么问题，高手能指正下吗？

在代码：Set Part = swApp.ActiveDoc下一段插入
Set Part = swApp.ActiveDoc
你的这句代码没有了

下面这段提示错误，也改一下，FileName = Left(FilePath, Len(FilePath) - 7)'取文件名，去后缀
改后：
FileName = Left(FileName, Len(FileName) - 7)   '取文件名，去后缀


作者: jujue    时间: 2017-2-8 08:32
qiminger 发表于 2017-2-7 16:25
在代码：Set Part = swApp.ActiveDoc下一段插入
Set Part = swApp.ActiveDoc
你的这句代码没有了

现在不报错了
但是还是不能输出，目标目录没有生成文件
' ******************************************************************************
' C:\TEM\swx3212\Macro1.swb - macro recorded on 04/14/15 by Administrator
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.ActiveDoc

Dim swModelName As String
Dim FileName As String
Dim i As Integer
swModelName = Part.GetPathName      '读取当前SW模型文档名(含路径)
i = InStrRev(swModelName, "\") '取"\"字符位置
FileName = Mid(swModelName, i + 1, Len(swModelName) - i) '取出文件名包含后缀
FileName = Left(FileName, Len(FileName) - 7)   '取文件名，去后缀



Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
Part.ViewZoomTo2 0, 0, 0, 0.1, 0.1, 0.1
longstatus = Part.SaveAs3("C:\Users\YZ01\Desktop\"" & FileName & "".DXF", 0, 0)
End Sub


逐句调试不会报错
大神再帮我看看  哪里还有问题啊  谢谢
作者: qiminger    时间: 2017-2-8 09:06
jujue 发表于 2017-2-8 08:32
现在不报错了
但是还是不能输出，目标目录没有生成文件
' ****************************************** ...

声明一下：我真不是大神，代码拼凑的，不要追问我太深了，怕解释不好误了您。一起学习研究。
下面附件内代码我测试了，应该没问题，你试试。
附件压缩包内为txt记事本文件
[attach]1244918[/attach]
作者: DaveChan    时间: 2017-2-8 09:56
试下以下代码
  1. Option Explicit
  2. Dim swApp As Object
  3. Dim Part As Object
  4. Dim FilePathName As String
  5. Dim FilePath As String
  6. Dim FileName As String
  7. Dim SheetName As String
  8. Dim DXFPathName As String
  9. Sub main()
  10. Set swApp = Application.SldWorks
  11. Set Part = swApp.ActiveDoc
  12. FilePathName = Part.GetPathName()
  13. FilePath = Left(FilePathName, InStrRev(FilePathName, "") - 1)
  14. FileName = Right(FilePathName, Len(FilePathName) - Len(FilePath) - 1)
  15. FileName = Left(FileName, Len(FileName) - 7)
  16. SheetName = Part.GetCurrentSheet.GetName
  17. DXFPathName = "C:\Users\YZ01\Desktop" & FileName & " " & SheetName & ".DXF"    '文件名 + 图纸名
  18. 'DXFPathName = "C:\Users\YZ01\Desktop" & FileName & ".DXF"     '文件名
  19. Part.SaveAs2 DXFPathName, 0, True, False
  20. End Sub
复制代码


作者: jujue    时间: 2017-2-8 17:41
qiminger 发表于 2017-2-8 09:06
声明一下：我真不是大神，代码拼凑的，不要追问我太深了，怕解释不好误了您。一起学习研究。
下面附件内 ...

在我的机器上还是运行了没反应，楼下有大师做出来了，你看看
作者: jujue    时间: 2017-2-8 17:43
DaveChan 发表于 2017-2-8 09:56
试下以下代码

谢谢大师了，完全正确  
作者: jujue    时间: 2017-2-8 17:51
DaveChan 发表于 2017-2-8 09:56
试下以下代码

请问下大师，要会这些东西需要学习什么呢？




欢迎光临 iCAx开思网 (https://www.icax.org/) Powered by Discuz! X3.3