關于solidworks轉換dwg的宏程序

響在江湖 · 發(fā)表于 2016-10-13 20:09:03

DaveChan 發(fā)表于 2016-10-4 08:22
* o8 D) f# ?% m: B; a- n給你兩個函數參考
4 w* f0 i6 O! R+ ]可以自己查找API0 @+ v$ o4 v& M9 O: c# g* W
這兩個函數都可以實現(xiàn)你要的功能

首先感謝社友回復，不過你發(fā)的這個怎么復制到txt中呀？復制代碼后只有“”ExportToDWG“這個。
還有API是什么？請指教。

DaveChan · 發(fā)表于 2016-10-13 21:17:18

響在江湖發(fā)表于 2016-10-13 20:09
- ?" h$ Z# ]6 d, f- H% P, c首先感謝社友回復，不過你發(fā)的這個怎么復制到txt中呀？復制代碼后只有“”ExportToDWG“這個。
: {5 X3 R& o+ r) P5 ^還有API ...

稍微修改了幫助文件里面的代碼代碼如下

Option Explicit
& y- i3 k V$ s- T* W
Dim swApp As SldWorks.SldWorks/ n c3 g; U4 \* a& ?5 y
Dim swModel As SldWorks.ModelDoc2
W1 S7 J) Z* J( D
Dim swModelDocExt As SldWorks.ModelDocExtension" W$ N1 n, E& F; f, X1 B, X0 b
Dim FileName As String
0 B& I$ q' X6 S
Dim NewName As String, ^7 [# i" U$ L! i q8 A% W$ k$ o
Dim boolstatus As Boolean- }: b) E Q" k& F4 L9 s" C
Dim longstatus As Long, longwarnings As Long9 V8 c+ @/ m, l, ]* N/ E
Sub main()
) O5 i4 J. D+ J) Y+ m( d: r0 w
Set swApp = Application.SldWorks
2 Z& V5 x9 H; P$ S$ X
Set swModel = swApp.ActiveDoc
) ^+ T* s! w d" d* l
Set swModelDocExt = swModel.Extension
& o3 @' Q6 w4 j& F* P8 w+ U
FileName = swModel.GetPathName()
5 V+ a9 K0 F3 o, f4 M4 j
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
: }. z; d X. r
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None)
- h1 R' X6 }7 ?( |8 V# n2 g
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings. w! `0 B. G3 }& \: Z) Z1 Y
End Sub
2 M4 C" r: }- d+ i2 U. E

復制代碼

響在江湖 · 發(fā)表于 2016-10-20 21:47:39

DaveChan 發(fā)表于 2016-10-13 21:17
2 j1 j6 v& W4 K2 M' F# Q- @稍微修改了幫助文件里面的代碼代碼如下

社區(qū)果然有高手存在��！為社區(qū)有這樣為人解惑的人存在感到欣慰！真心感謝為我解決頭疼的問題，不過因為是水刀下料，可不可以轉換后不要折彎線？就像默認的那樣。忘高手進一步解答。再次感謝！

DaveChan · 發(fā)表于 2016-10-21 13:49:04

響在江湖發(fā)表于 2016-10-20 21:47
8 i0 X4 _; Z5 A( z/ x社區(qū)果然有高手存在��！為社區(qū)有這樣為人解惑的人存在感到欣慰！真心感謝為我解決頭疼的問題，不過因為是 ...

移除折彎線代碼如下：

Option Explicit
! N/ {1 Y9 I& a
Dim swApp As SldWorks.SldWorks; |+ E( h* }1 F- B$ T
Dim swModel As SldWorks.ModelDoc22 k; X) f# j0 g- A/ G# W. P( R
Dim swModelDocExt As SldWorks.ModelDocExtension5 A$ u# b& Y: s1 s3 M
Dim FileName As String
, M3 j( C& z5 n- ]8 u
Dim NewName As String* z6 ^# p1 v0 _4 K- X( ^0 R Y
Dim boolstatus As Boolean" m- _ g9 w: M& x) p
Dim longstatus As Long, longwarnings As Long8 o# Q8 U1 {9 C$ q; L' c
Sub main()
# M1 l6 w; i# O& V
Set swApp = Application.SldWorks
7 W: Y. I {- T3 Z, s
Set swModel = swApp.ActiveDoc* R; P$ L/ t+ G9 F
Set swModelDocExt = swModel.Extension
! K6 n- _, y2 a+ l7 D! |4 r; u
FileName = swModel.GetPathName(). i& Y9 P5 } f) c7 g* ? C
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
$ k5 T$ |" _" q3 e
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends)4 M$ d* M, y3 r. K
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings" T9 P( X# c6 N5 O# l3 R0 K! n
End Sub
" [6 q, @' |* z

復制代碼

tyne1314 · 發(fā)表于 2016-10-22 14:03:02

能把這個宏分享一下么？這可以方便做鈑金展開的朋友們呀，謝謝

響在江湖 · 發(fā)表于 2016-10-23 10:25:00

tyne1314 發(fā)表于 2016-10-22 14:03$ ?9 e+ t. o. {& t( L
能把這個宏分享一下么？這可以方便做鈑金展開的朋友們呀，謝謝

我試試啊

響在江湖 · 發(fā)表于 2016-10-23 10:26:54

DaveChan 發(fā)表于 2016-10-21 13:49
& y1 y. C% P3 [4 }, n5 V& w: _; ]移除折彎線代碼如下：

太牛了！真心感謝，應社友要求共享該程序不知這個借花獻佛可以不？呵呵

響在江湖 · 發(fā)表于 2016-10-23 10:27:37

tyne1314 發(fā)表于 2016-10-22 14:03
7 N, O0 c, ~7 x S9 f( w' y能把這個宏分享一下么？這可以方便做鈑金展開的朋友們呀，謝謝

你是專門學過VB嗎？還是也是錄制的宏程序？

DaveChan · 發(fā)表于 2016-10-23 10:34:12

響在江湖發(fā)表于 2016-10-23 10:27
4 x$ m: n" C- k2 X, c. H |! j: h你是專門學過VB嗎？還是也是錄制的宏程序？

可以共享的，這些代碼是API幫助現(xiàn)成的，我只是稍微更改了一下，符合你的要求而已

我編程只是業(yè)余愛好而已，不專業(yè)

leilei333 · 發(fā)表于 2017-12-4 23:46:03

頂一萬個贊

		自動登錄	找回密碼
密碼			注冊會員