SolidWorks机械工程师网——最大的SolidWorks学习平台

 找回密码
 立即注册

QQ登录

只需一步,快速开始

好品数字
好品数字
查看: 4845|回复: 17
打印 上一主题 下一主题

跪求SW工程图转PDF和CAD的宏!!!!!!

  [复制链接]

1

主题

23

帖子

563

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1563

最佳新人活跃会员宣传达人

跳转到指定楼层
楼主
 楼主| 发表于 2018-12-7 08:17:27 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
各位大神,小弟需要SW工程图转PDF和CAD的宏!!!!!!哪位大哥有的麻烦发下本人扣扣邮箱,感谢。766731497@qq.com
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏1 转播转播 分享教程|习题|模型|技巧 点赞点赞 拍砖拍砖
SolidWorks机械工程师网
提示:建议使用谷歌浏览器浏览本网站!如单击这里下载!否则,可能无法下载附件文件!(支持大多数版本的谷歌浏览器,支持10、11两个版本的IE浏览器,支持360和QQ浏览器的极速模式,即谷歌内核模式,以及10和11版本的IE兼容模式,其余浏览器也是如此)
回复

使用道具 举报

1

主题

23

帖子

563

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1563

最佳新人活跃会员宣传达人

沙发
 楼主| 发表于 2018-12-7 08:41:54 | 只看该作者
各位大神,走过路过,有这个宏的麻烦发一下,小弟急用!!!
SolidWorks机械工程师网
提示:建议使用谷歌浏览器浏览本网站!如单击这里下载!否则,可能无法下载附件文件!(支持大多数版本的谷歌浏览器,支持10、11两个版本的IE浏览器,支持360和QQ浏览器的极速模式,即谷歌内核模式,以及10和11版本的IE兼容模式,其余浏览器也是如此)
回复 支持 反对

使用道具 举报

9

主题

145

帖子

730

金币

传奇

爱学习的版主

Rank: 8Rank: 8

积分
6434

最佳新人活跃会员热心会员宣传达人灌水之王

QQ
板凳
发表于 2018-12-7 16:08:12 | 只看该作者
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FilesPath As String
Dim swAA As String

Sub main()
Set swApp = Application.SldWorks                        '建立与SolidWorks的连接
Set Part = swApp.ActiveDoc                              '得到SolidWorks应用程序对象
FilesPath = swApp.ActiveDoc.GetPathName()               '获取当前零件全路径
swAA = Left(FilesPath, Len(FilesPath) - 6)              '去掉图纸后缀“SLDDRW”
swBB = "dwg"                                            '添加CAD后缀“dwg” ,如果存为PDF 就改成“pdf”
longstatus = Part.SaveAs3(swAA & swBB, 0, 0)            '另存为.......
End Sub
终究还得自己做自己的主角,所以必须坚强走下去。
回复 支持 反对

使用道具 举报

9

主题

145

帖子

730

金币

传奇

爱学习的版主

Rank: 8Rank: 8

积分
6434

最佳新人活跃会员热心会员宣传达人灌水之王

QQ
地板
发表于 2018-12-7 16:28:29 | 只看该作者
  1. Dim swApp As Object
  2. Dim Part As Object
  3. Dim boolstatus As Boolean
  4. Dim longstatus As Long, longwarnings As Long
  5. Dim Filespath As String
  6. Dim swAA As String, swBB As String

  7. Sub main()
  8. Set swApp = Application.SldWorks
  9. Set Part = swApp.ActiveDoc
  10. Filespath = swApp.ActiveDoc.GetPathName()
  11. swAA = Left(Filespath, Len(Filespath) - 6)
  12. swBB = "dwg"                                                  ‘转换CAD 为 dwg,转换PDF 为 pdf
  13. longstatus = Part.SaveAs3(swAA & swBB, 0, 0)
  14. End Sub
复制代码
终究还得自己做自己的主角,所以必须坚强走下去。
回复 支持 反对

使用道具 举报

1

主题

23

帖子

563

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1563

最佳新人活跃会员宣传达人

5#
 楼主| 发表于 2018-12-8 08:30:31 | 只看该作者

   经典案例图书

试了下,说语句错误,可能我哪里弄错了,不过我找到一个我能用的了:
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim PathStr As String
Dim FName(500) As String, FNum As Long

Sub main()
Dim i As Long
Dim PathStr0 As String, PathStr1 As String
Dim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String
Dim L As Long, L1 As Long
PathStr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(PathStr)
Set swApp = Application.SldWorks

For i = 0 To FNum - 1
PathStr0 = PathStr & "\" & FName(i)
Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
L = Len(PathStr0)
PathStr1 = Left(PathStr0, L - 7) & ".DWG"
PathStr2 = Left(PathStr0, L - 7) & ".PDF"
longstatus = Part.SaveAs3(PathStr1, 0, 0)
longstatus = Part.SaveAs3(PathStr2, 0, 0)

Set Part = Nothing

L1 = Len(FName(i))
PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"
PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2"
PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"

swApp.CloseDoc PathStr3
swApp.CloseDoc PathStr4
swApp.CloseDoc PathStr5
Next i

End Sub

Private Sub Showfilelist(folderspec As String)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
FNum = 0 '清零
For Each f1 In fc
If InStr(f1.Name,"SLDDRW") > 0 Then
FName(FNum) = f1.Name
FNum = FNum + 1
End If
Next
End Sub                                                                                                                                             

另外,附上我找到的图号分离宏:
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
Dim Part As Object
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swConfig As SldWorks.Configuration
Dim CustPropMgr As SldWorks.CustomPropertyManager
Dim swModel As SldWorks.ModelDoc2

Sub main()
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration
Set swModel = swApp.ActiveDoc
Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name) '配置特定延伸

'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
a = InStr(c, " ") - 1      '重点:分隔标识符,这里是一个空格,也可换成其他符号

If a > 0 Then
       k = Left(c, a)
       t = Left(LTrim(e), 3)
       If t = "GBT" Then
             e = "GB/T" + Mid(k, 4)
       Else
             e = k
       End If
       b = Mid(c, a + 2)
       t = Right(c, 7)
       If t = ".SLDPRT" Or t = ".SLDASM" Or t = ".sldprt" Or t = ".sldasm" Then
             j = Len(b) - 7 '消除后缀(区分大小写,即含4种)
       Else
             j = Len(b)
       End If
       m = Left(b, j)
End If
'删除栏  CustPropMgr.Delete ("PartName")
CustPropMgr.Delete ("PartName")
CustPropMgr.Delete ("Number")

'新增
CustPropMgr.Add2 "Number", swCustomInfoText, e
CustPropMgr.Add2 "PartName", swCustomInfoText, m
CustPropMgr.Add2 "数量", swCustomInfoText, ""
CustPropMgr.Add2 "Material", swCustomInfoText, strmat
CustPropMgr.Add2 "Weight", swCustomInfoText, ""
CustPropMgr.Add2 "总重", swCustomInfoText, ""
CustPropMgr.Add2 "Description", swCustomInfoText, ""

End Sub
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

9

主题

145

帖子

730

金币

传奇

爱学习的版主

Rank: 8Rank: 8

积分
6434

最佳新人活跃会员热心会员宣传达人灌水之王

QQ
6#
发表于 2018-12-8 09:26:35 | 只看该作者
  1. Dim swApp As Object
  2. Dim Part As Object
  3. Dim boolstatus As Boolean
  4. Dim longstatus As Long
  5. Dim Filespath As String
  6. Dim swAA As String, swBB As String

  7. Sub main()
  8. Set swApp = Application.SldWorks
  9. Set Part = swApp.ActiveDoc
  10. Filespath = swApp.ActiveDoc.GetPathName()
  11. swAA = Left(Filespath, Len(Filespath) - 6)
  12. swBB = "dwg"
  13. longstatus = Part.SaveAs3(swAA & swBB, 0, 0)
  14. End Sub
复制代码

该宏需要你在打开工程图的情况下执行,出错可能是我注释的那一句的注释符号错了!去掉就行了!
终究还得自己做自己的主角,所以必须坚强走下去。
回复 支持 反对

使用道具 举报

1

主题

23

帖子

563

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1563

最佳新人活跃会员宣传达人

7#
 楼主| 发表于 2018-12-10 08:09:33 | 只看该作者

   经典案例图书
suzhanpeng 发表于 2018-12-8 09:26
该宏需要你在打开工程图的情况下执行,出错可能是我注释的那一句的注释符号错了!去掉就行了!

用我发现的那个宏,运行后,复制黏贴目标文件夹路径,可以把目标文件夹内所有工程图转为CAD和PDF。批量转换,而且不用打开工程图。
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

1

主题

57

帖子

175

金币

侠客

Rank: 3Rank: 3Rank: 3

积分
343
QQ
8#
发表于 2018-12-10 11:18:03 | 只看该作者
很不错,顶一下!
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

97

主题

332

帖子

2976

金币

传奇

Rank: 8Rank: 8

积分
7916

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献

9#
发表于 2018-12-10 14:35:22 | 只看该作者
hyqlyy 发表于 2018-12-7 08:41
各位大神,走过路过,有这个宏的麻烦发一下,小弟急用!!!

https://www.swbbsc.com/forum.php?mod=viewthread&tid=33355

參考如上 10#
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

6

主题

611

帖子

816

金币

实习版主

Rank: 7Rank: 7Rank: 7Rank: 7

积分
5254

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献

10#
发表于 2018-12-18 21:48:24 | 只看该作者
很不错,找到组织了!
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

9

主题

78

帖子

262

金币

堂主

Rank: 4

积分
842

最佳新人活跃会员热心会员宣传达人

11#
发表于 2019-2-10 19:24:10 | 只看该作者
楼主太有才了,膜拜中……
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

9

主题

78

帖子

262

金币

堂主

Rank: 4

积分
842

最佳新人活跃会员热心会员宣传达人

12#
发表于 2019-2-11 10:15:19 | 只看该作者
好好学习,天天向上!
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

3

主题

309

帖子

22

金币

堂主

Rank: 4

积分
985

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献

13#
发表于 2019-2-14 09:43:31 | 只看该作者
附件传不上去啊!
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

6

主题

417

帖子

662

金币

传奇

Rank: 8Rank: 8

积分
4240

最佳新人活跃会员热心会员宣传达人灌水之王突出贡献

14#
发表于 2020-6-9 17:29:33 | 只看该作者
好东西,努力学习学习!
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

0

主题

15

帖子

47

金币

天使

Rank: 2Rank: 2

积分
134

最佳新人宣传达人

15#
发表于 2021-11-3 11:33:38 | 只看该作者
加入QQ群
参与讨论和学习

SolidWorks技术交流群

或扫描二维码加入

感谢分享辛苦了
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

4

主题

75

帖子

227

金币

堂主

Rank: 4

积分
945

最佳新人活跃会员热心会员宣传达人

16#
发表于 2021-12-30 13:08:18 | 只看该作者

   经典案例图书

这是我见过最简单的代码,666
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

0

主题

62

帖子

23

金币

堂主

Rank: 4

积分
626

最佳新人活跃会员热心会员宣传达人

17#
发表于 2023-4-2 19:08:48 | 只看该作者
加入QQ群
参与讨论和学习

SolidWorks技术交流群

或扫描二维码加入

hyqlyy 发表于 2018-12-10 08:09
用我发现的那个宏,运行后,复制黏贴目标文件夹路径,可以把目标文件夹内所有工程图转为CAD和PDF。批量转 ...

很不错,顶一下!
如何同时转出STEP档案呢?可否一起转出3种格式呢?
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

2

主题

131

帖子

512

金币

长老

Rank: 6Rank: 6Rank: 6

积分
1661

最佳新人活跃会员热心会员宣传达人

18#
发表于 2023-4-3 08:56:45 | 只看该作者

   经典案例图书
多谢分享,下载备用
SolidWorks机械工程师网
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

关闭 卷起
关闭 卷起

手机版|小黑屋| GMT+8, 2024-3-29 17:55 , Processed in 0.475536 second(s), 34 queries .

SolidWorks机械工程师网 ( 鲁ICP备14025122号-2 ) 鲁公网安备 37028502190335号

声明:本网言论纯属发表者个人意见,与本网立场无关。
如涉版权,可发邮件: admin@swbbsc.com

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