关于solidworks转换dwg的宏程序

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

DaveChan 发表于 2016-10-4 08:22! }: |: ~7 T+ g1 s/ ^5 s- S
给你两个函数参考: h, c4 v; E7 F* g
可以自己查找API& w9 g$ x: I& u, z$ D- o K
这两个函数都可以实现你要的功能

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

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

响在江湖发表于 2016-10-13 20:09
2 a$ g8 I0 [5 Q: t8 |" ` z: m首先感谢社友回复，不过你发的这个怎么复制到txt中呀？复制代码后只有“”ExportToDWG“这个。5 m" l' t1 A* o. L
还有API ...

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

Option Explicit+ _' l6 ^6 n/ @, e
Dim swApp As SldWorks.SldWorks9 S4 R8 W: H/ y! }
Dim swModel As SldWorks.ModelDoc2
9 X8 Q7 ]6 i6 ^6 W" b% q
Dim swModelDocExt As SldWorks.ModelDocExtension
+ e- x6 Y1 `* I( F) D( c
Dim FileName As String
, H9 o) i5 F) y, B# ^# S$ R& M
Dim NewName As String2 e8 y% p: _+ t$ O/ t: c0 w% f0 G
Dim boolstatus As Boolean/ b9 K6 V- Y& R& _4 w0 _ {8 _; U
Dim longstatus As Long, longwarnings As Long
, I8 l! F% t; U3 I% C) Z1 r
Sub main(). o3 I, G1 ], ]8 \
Set swApp = Application.SldWorks
7 P& Y: I$ p/ N. h
Set swModel = swApp.ActiveDoc
C6 ]3 t# l0 _# L5 n4 x% R
Set swModelDocExt = swModel.Extension
0 P! g% L# q% D; P# ^3 @
FileName = swModel.GetPathName()5 N g& b5 {3 a1 A
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
- K$ ]6 k# g) ~5 `. \5 S% h
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None)
8 A# i1 O8 p+ K2 g) w0 N
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
5 c) }/ p# V2 C5 N" u( J% n
End Sub
! w; d2 q# M; k# C

复制代码

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

DaveChan 发表于 2016-10-13 21:17
+ w$ m- c' e1 b5 K稍微修改了帮助文件里面的代码代码如下

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

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

响在江湖发表于 2016-10-20 21:47 n! U5 {1 @6 w* I
社区果然有高手存在啊！为社区有这样为人解惑的人存在感到欣慰！真心感谢为我解决头疼的问题，不过因为是 ...

移除折弯线代码如下：

Option Explicit
4 k' E# X N9 m' ?* F- S: N! {
Dim swApp As SldWorks.SldWorks
4 w- ^, k' O. d6 I5 z/ x, v3 f
Dim swModel As SldWorks.ModelDoc2
% z5 s; L5 ] Y! U4 R% G
Dim swModelDocExt As SldWorks.ModelDocExtension" f# F. l0 o, `3 }! ^% E% V$ u* V
Dim FileName As String
4 P2 J0 j+ y- D) }1 V: p$ E
Dim NewName As String
. V q% a( E# {+ q( Y6 I- D
Dim boolstatus As Boolean4 a4 Z1 V8 ?$ Z; r0 f
Dim longstatus As Long, longwarnings As Long
6 C. p4 r: c7 \/ P1 j2 A
Sub main()* D) c; S5 p; Z7 O
Set swApp = Application.SldWorks
. d6 i0 a7 K' @+ Z
Set swModel = swApp.ActiveDoc+ X7 |4 J1 ^8 c) x
Set swModelDocExt = swModel.Extension; X/ g- W- k2 ~
FileName = swModel.GetPathName()
% v0 b' q: p! K8 \: |, I
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"" B! E/ Y% N3 @! k& l$ Q
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends)
. Z) K- V, `. | H1 g. S. @* P$ }
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings' x0 ]; b' w- h4 q) ?8 `2 ^5 e* n
End Sub
! I& L$ r( b" I" U

复制代码

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

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

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

tyne1314 发表于 2016-10-22 14:03
! Q" o x; i+ R9 t2 c能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

我试试啊

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

DaveChan 发表于 2016-10-21 13:49
$ |$ R U- V3 P+ Y移除折弯线代码如下：

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

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

tyne1314 发表于 2016-10-22 14:03
3 Q. p, l6 I# U( Q( l1 o5 s. ~能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

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

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

响在江湖发表于 2016-10-23 10:27
3 Y1 D8 M n# d6 Q; a' d/ E你是专门学过VB吗？还是也是录制的宏程序？

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

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

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

顶一万个赞

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