关于solidworks转换dwg的宏程序

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

DaveChan 发表于 2016-10-4 08:22
9 l% b; M$ V1 [9 N+ v: B3 P- h% t给你两个函数参考
G' S: q B) z7 o O可以自己查找API" Q, h$ @" k; ]0 P' z2 N
这两个函数都可以实现你要的功能

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

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

响在江湖发表于 2016-10-13 20:099 Y3 H# C1 g. L; `" i4 ~
首先感谢社友回复，不过你发的这个怎么复制到txt中呀？复制代码后只有“”ExportToDWG“这个。
, X; f9 c: b& h! A# S1 u% c" ~* H还有API ...

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

Option Explicit
; o& n$ I. D3 s& E( Z( I
Dim swApp As SldWorks.SldWorks' I( S/ ^4 {# {
Dim swModel As SldWorks.ModelDoc2
- j. I( e( Y" j; Y, }' T
Dim swModelDocExt As SldWorks.ModelDocExtension
% h3 t& B9 U1 o. E5 s
Dim FileName As String3 Z- k4 D. w5 {$ C/ |! k
Dim NewName As String
/ W2 n, |( P7 e& D$ f) _/ u
Dim boolstatus As Boolean G$ `' G! u% d/ u- t& E8 E; ?& u
Dim longstatus As Long, longwarnings As Long
R& l' V$ ?/ ~/ q# ^" C. G. a
Sub main()" ~% q! |: r/ V6 ?
Set swApp = Application.SldWorks
; ]+ |0 f" G/ F& u& b
Set swModel = swApp.ActiveDoc4 i; `6 Z9 R+ L$ `4 g" }' b
Set swModelDocExt = swModel.Extension' x; [9 j( ~2 U& I
FileName = swModel.GetPathName()
9 K& b, Q. D5 c. X, |( z
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
% q6 j# S4 _3 d( p
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None); o5 J8 j4 C8 }) i
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
* g4 m; T2 m1 y! Z/ x5 O" _
End Sub
% f- u, D0 m6 B4 P

复制代码

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

DaveChan 发表于 2016-10-13 21:173 \( ^) N' f: l! Q( h/ g2 ~% n& o
稍微修改了帮助文件里面的代码代码如下

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

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

响在江湖发表于 2016-10-20 21:47 z+ N" s3 u: x7 P" U
必威体育网址果然有高手存在啊！为必威体育网址有这样为人解惑的人存在感到欣慰！真心感谢为我解决头疼的问题，不过因为是 ...

移除折弯线代码如下：

Option Explicit8 @( x' ?+ M8 y7 z7 d' _: O
Dim swApp As SldWorks.SldWorks
/ k! Q) G) E+ Y# l; [1 i- e
Dim swModel As SldWorks.ModelDoc2/ p- ~8 h: D0 ~7 B
Dim swModelDocExt As SldWorks.ModelDocExtension
5 ^1 M! w2 `- M' N6 W# k
Dim FileName As String S! q+ ], d( r# c& E* w4 v
Dim NewName As String
! P! N. C* Q! I5 \$ \
Dim boolstatus As Boolean8 D- h# T5 s7 D
Dim longstatus As Long, longwarnings As Long
; k: A% S1 `% r+ N+ T
Sub main()
9 k+ u5 l/ h2 K4 |* p! Q# ]
Set swApp = Application.SldWorks
0 Z$ |" P5 Z0 u& c5 p1 F z& w$ O
Set swModel = swApp.ActiveDoc
. i4 E! }3 W- T
Set swModelDocExt = swModel.Extension
v* q8 z, a) L. a) \( `5 f/ Z
FileName = swModel.GetPathName()
4 c7 d+ o# I/ f
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"- R4 X+ I$ v3 n1 s7 @# ?
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends); k: R9 T; K8 W, \
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
& K7 M/ k1 k6 o, q! B
End Sub; Y' C% V4 M5 l. P+ j4 L+ j1 d2 R8 k

复制代码

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

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

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

tyne1314 发表于 2016-10-22 14:03
. b9 Q5 p2 f2 J. q* [* x2 C# p能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

我试试啊

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

DaveChan 发表于 2016-10-21 13:491 M% k" F/ R% v* ?9 m6 A
移除折弯线代码如下：

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

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

tyne1314 发表于 2016-10-22 14:03( N: M- T% J& e2 f) A! K& L
能把这个宏分享一下么？这可以方便做钣金展开的朋友们呀，谢谢

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

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

响在江湖发表于 2016-10-23 10:27 L& v9 {! l5 n6 ]
你是专门学过VB吗？还是也是录制的宏程序？

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

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

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

顶一万个赞

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