找回密码 注册 QQ登录
开思网工业级高精度在线3D打印服务

iCAx开思网

CAD/CAM/CAE/设计/模具 高清视频【积分说明】如何快速获得积分?快速3D打印 手板模型CNC加工服务在线3D打印服务,上传模型,自动报价
查看: 5048|回复: 9
打印 上一主题 下一主题

[已解决] 用宏半自动输出 DXF 时,文件名的变量是什么呢

[复制链接]
跳转到指定楼层
1
发表于 2017-2-7 11:20:23 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式

马上注册,结交更多同行朋友,交流,分享,学习。

您需要 登录 才可以下载或查看,没有帐号?注册

x
本帖最后由 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

-----------------------------------------
并且设置了宏按钮


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

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

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

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享淘帖 赞一下!赞一下!
推荐
发表于 2017-2-8 09:56:10 | 只看该作者
试下以下代码
  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
复制代码


2
发表于 2017-2-7 12:47:07 | 只看该作者
本帖最后由 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文本文件,方便复制

3
发表于 2017-2-7 15:29:02 | 只看该作者
qiminger 发表于 2017-2-7 12:47
在代码:Set Part = swApp.ActiveDoc下一段插入:

Dim swModelName As String


修改后不能自动输出了, 逐语句调试到这里 报错,菜鸟不懂是什么问题,高手能指正下吗?
4
发表于 2017-2-7 16:25:52 | 只看该作者
本帖最后由 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)   '取文件名,去后缀


5
发表于 2017-2-8 08:32:56 | 只看该作者
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


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

声明一下:我真不是大神,代码拼凑的,不要追问我太深了,怕解释不好误了您。一起学习研究。
下面附件内代码我测试了,应该没问题,你试试。
附件压缩包内为txt记事本文件

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

在我的机器上还是运行了没反应,楼下有大师做出来了,你看看
9
发表于 2017-2-8 17:43:00 | 只看该作者

谢谢大师了,完全正确  
10
发表于 2017-2-8 17:51:35 | 只看该作者

请问下大师,要会这些东西需要学习什么呢?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

3D打印手板模型快速制作服务,在线报价下单!

QQ 咨询|手机版|联系我们|iCAx开思网  

GMT+8, 2025-4-20 01:16 , Processed in 0.025417 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.3

© 2002-2025 www.iCAx.org

快速回复 返回顶部 返回列表