关于solidworks转换dwg的宏程序

响在江湖 · 发表于 2016-10-13 20:09:03

DaveChan 发表于 2016-10-4 08:22
8 D9 C& D1 F7 r( u8 k; k% \" P给你两个函数参考
* l8 ]7 U: U1 O# Y/ a3 P4 ]可以自己查找API% ?% ]( [+ A; C' \; T
这两个函数都可以实现你要的功能

首先感谢社友回复，不过你发的这个怎么复制到txt中呀？复制代码后只有“”ExportToDWG“这个。
还有API是什么？请指教。

DaveChan · 发表于 2016-10-13 21:17:18

响在江湖发表于 2016-10-13 20:09/ x, F) W, ]2 \1 \, z
首先感谢社友回复，不过你发的这个怎么复制到txt中呀？复制代码后只有“”ExportToDWG“这个。4 J# ^! t M" x; D- h
还有API ...

稍微修改了帮助文件里面的代码代码如下

Option Explicit
( m d4 C- v1 }7 a
Dim swApp As SldWorks.SldWorks
4 b" p* L" k/ J
Dim swModel As SldWorks.ModelDoc2
) {" k, y" x; ?1 T5 H! k. ?+ \
Dim swModelDocExt As SldWorks.ModelDocExtension
6 ~5 {5 U" I I+ P$ \5 t5 A& Y D
Dim FileName As String
4 W* D3 W/ D; B8 q$ _, L
Dim NewName As String" l8 |7 U, [1 G3 A+ G7 s9 |
Dim boolstatus As Boolean6 p- R8 d) \1 X5 A0 {
Dim longstatus As Long, longwarnings As Long
0 C2 g7 b" ]9 ?$ u6 U b
Sub main()" E3 D# `) L% U- [% y
Set swApp = Application.SldWorks
+ o+ [8 L/ j2 @8 M) a5 e' b
Set swModel = swApp.ActiveDoc, i0 m! c4 N: P r8 I; `0 U: x% q
Set swModelDocExt = swModel.Extension% t; [! t2 `+ V* v
FileName = swModel.GetPathName()
0 a. C, w" T, j4 w# C: B* \
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"" X9 @( G' _5 [5 V0 U9 F
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None)
+ n- c6 Y: D" O( F+ k
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
# u0 a# F& k, i/ v
End Sub
/ T7 N7 B# d0 [0 ^% x

复制代码

响在江湖 · 发表于 2016-10-20 21:47:39

DaveChan 发表于 2016-10-13 21:172 x2 C, Q E- H! z/ v
稍微修改了帮助文件里面的代码代码如下

必威体育网址果然有高手存在啊！为必威体育网址有这样为人解惑的人存在感到欣慰！真心感谢为我解决头疼的问题，不过因为是水刀下料，可不可以转换后不要折弯线？就像默认的那样。忘高手进一步解答。再次感谢！

DaveChan · 发表于 2016-10-21 13:49:04

响在江湖发表于 2016-10-20 21:477 T3 N) `. i0 L4 u
必威体育网址果然有高手存在啊！为必威体育网址有这样为人解惑的人存在感到欣慰！真心感谢为我解决头疼的问题，不过因为是 ...

移除折弯线代码如下：

Option Explicit2 V: ]: t) b7 i9 Q
Dim swApp As SldWorks.SldWorks0 a5 X, [: k2 L! l# D: n* s
Dim swModel As SldWorks.ModelDoc2: ^& s/ k* i9 B) @% o% r8 _
Dim swModelDocExt As SldWorks.ModelDocExtension8 K9 E% B7 U4 l5 c( l# @* D
Dim FileName As String+ N$ _' Z! ^2 N+ @& T
Dim NewName As String! D* C4 R2 k* M
Dim boolstatus As Boolean; B# `) ~0 E0 _* T9 d* n
Dim longstatus As Long, longwarnings As Long* f7 j& O1 c! b! J: O
Sub main()- `: y o; D" Q" E
Set swApp = Application.SldWorks
9 _! z F1 f) x5 G, b) L
Set swModel = swApp.ActiveDoc
# [ T3 v+ R9 k% g; h! c R. B2 q
Set swModelDocExt = swModel.Extension
1 k+ [3 D+ W( ~8 r( S* h
FileName = swModel.GetPathName()
& F; O, {3 z$ F3 {' O! P
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
. J2 C4 ?/ ~ |4 a: R9 a: C
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends): h& l* u* o" L) d5 s( J$ Q+ x$ [9 H
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
' Z& [2 @9 p! S/ f! ?
End Sub
7 ^4 t G$ a* P2 \% T

复制代码

tyne1314 · 发表于 2016-10-22 14:03:02

能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

响在江湖 · 发表于 2016-10-23 10:25:00

tyne1314 发表于 2016-10-22 14:03
' w4 {, i3 u: P能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

我试试啊

响在江湖 · 发表于 2016-10-23 10:26:54

DaveChan 发表于 2016-10-21 13:497 A |6 X* f+ F' x( P& L2 O. x
移除折弯线代码如下：

太牛了！真心感谢，应社友要求共享该程序不知这个借花献佛可以不？呵呵

响在江湖 · 发表于 2016-10-23 10:27:37

tyne1314 发表于 2016-10-22 14:03
5 ]. H- h x( A1 I7 q能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

你是专门学过VB吗？还是也是录制的宏程序？

DaveChan · 发表于 2016-10-23 10:34:12

响在江湖发表于 2016-10-23 10:27
5 O+ z" s& ? _2 W4 ~+ z2 J# H/ {. K你是专门学过VB吗？还是也是录制的宏程序？

可以共享的，这些代码是API帮助现成的，我只是稍微更改了一下，符合你的要求而已

我编程只是业余爱好而已，不专业

leilei333 · 发表于 2017-12-4 23:46:03

顶一万个赞

		自动登录	找回密码
密码			注册会员