關(guān)于solidworks轉(zhuǎn)換dwg的宏程序

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

DaveChan 發(fā)表于 2016-10-4 08:22
F) |/ U1 n- _% d3 v% J, @給你兩個(gè)函數(shù)參考
% Y& s8 \; f" J, q/ z1 [可以自己查找API, J+ D# f8 y! v- p$ Z1 T
這兩個(gè)函數(shù)都可以實(shí)現(xiàn)你要的功能

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

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

響在江湖發(fā)表于 2016-10-13 20:09
" y. d( C+ I# Z) N首先感謝社友回復(fù),，不過你發(fā)的這個(gè)怎么復(fù)制到txt中呀,？復(fù)制代碼后只有“”ExportToDWG“這個(gè)。* ^" E" a& N- O
還有API ...

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

Option Explicit8 [2 ^4 E8 T$ G0 i% g- K: l V( b
Dim swApp As SldWorks.SldWorks2 J5 j# a6 C% t7 Z- f; i
Dim swModel As SldWorks.ModelDoc27 M5 \' P5 {5 y! c: t- b# k
Dim swModelDocExt As SldWorks.ModelDocExtension
; E3 q+ b- Q8 l \$ G2 r# L0 U; Y
Dim FileName As String( c, u5 C& _! O$ y
Dim NewName As String
* I9 X- E* V O$ l% F u
Dim boolstatus As Boolean
; I/ {( X$ L% m5 n, B
Dim longstatus As Long, longwarnings As Long2 b1 [. Y0 H. w) I0 c& c6 R
Sub main()
d# Y' w$ c& a" ?+ k; e1 ?
Set swApp = Application.SldWorks; [' L' k5 e' x7 R5 i
Set swModel = swApp.ActiveDoc
! x* z) o' c% H) \* v! {( U
Set swModelDocExt = swModel.Extension6 h! t" g* N5 R- v& f. I
FileName = swModel.GetPathName()
. F5 Y! }3 G% b. _* e2 e
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
- {2 c1 D' w4 m2 Z2 ^
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None)
" v) G6 u: c ^& v* v+ }
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings% u3 v* y' @& k- n+ |& p
End Sub
7 Y8 f) Z% }' E: ^; _+ x% ]

復(fù)制代碼

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

DaveChan 發(fā)表于 2016-10-13 21:17
# {' N! ]) R& T/ s9 r# Q" g稍微修改了幫助文件里面的代碼代碼如下

社區(qū)果然有高手存在�,�,！為社區(qū)有這樣為人解惑的人存在感到欣慰！真心感謝為我解決頭疼的問題,，不過因?yàn)槭撬断铝�,，可不可以轉(zhuǎn)換后不要折彎線？就像默認(rèn)的那樣,。忘高手進(jìn)一步解答,。再次感謝！

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

響在江湖發(fā)表于 2016-10-20 21:47+ F) M' G8 Q/ Y- T! W& q* i
社區(qū)果然有高手存在�,�,！為社區(qū)有這樣為人解惑的人存在感到欣慰！真心感謝為我解決頭疼的問題,，不過因?yàn)槭?...

移除折彎線代碼如下：

Option Explicit
B$ f# @# H* u& I8 F& e9 M5 }9 W8 B
Dim swApp As SldWorks.SldWorks7 z( _- i3 T! Z( ?/ m
Dim swModel As SldWorks.ModelDoc2
/ h3 o5 a& @' V+ `# Z6 r
Dim swModelDocExt As SldWorks.ModelDocExtension; J6 z8 x! }0 {/ s* j( L- }
Dim FileName As String
" D8 J5 Z2 M( E
Dim NewName As String
5 h, L9 ^7 y$ ^6 T; j2 t
Dim boolstatus As Boolean3 U; W5 l6 O/ S, ^' g8 E/ L8 `
Dim longstatus As Long, longwarnings As Long* b9 m6 F0 [0 s# S9 n" k, ?
Sub main()
. d9 k8 A3 U# U4 z3 G$ Z8 P% N0 O
Set swApp = Application.SldWorks
l( v; T! u, ? b! g
Set swModel = swApp.ActiveDoc! N. I A- R0 H/ r9 b$ I$ O
Set swModelDocExt = swModel.Extension$ j- [0 o8 e; V+ y$ k$ v0 |# u! B
FileName = swModel.GetPathName()
) ^/ ]0 l5 d2 \! n& U
NewName = Left(FileName, Len(FileName) - 7) & ".dwg"" v' `+ E1 Z% [& }
boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends)
: L; n1 I- a8 Q& E' u+ g* M
swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
. q( w. D E8 e0 q
End Sub
. X5 x- C) i* y' R% d

復(fù)制代碼

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

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

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

tyne1314 發(fā)表于 2016-10-22 14:03
9 k- ~0 J5 B1 {& h8 R能把這個(gè)宏分享一下么,？這可以方便做鈑金展開的朋友們呀,，謝謝

我試試啊

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

DaveChan 發(fā)表于 2016-10-21 13:49: T/ ^' {- Y1 ^4 G3 l0 x; Z) b- z
移除折彎線代碼如下：

太牛了！真心感謝,，應(yīng)社友要求共享該程序不知這個(gè)借花獻(xiàn)佛可以不,？呵呵

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

tyne1314 發(fā)表于 2016-10-22 14:03
3 i2 S1 z; u- r* O' l2 ^; N能把這個(gè)宏分享一下么？這可以方便做鈑金展開的朋友們呀,，謝謝

你是專門學(xué)過VB嗎,？還是也是錄制的宏程序？

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

響在江湖發(fā)表于 2016-10-23 10:27
3 V, M. [) P# c% L3 r: E, V3 _( v你是專門學(xué)過VB嗎,？還是也是錄制的宏程序,？

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

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

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

頂一萬個(gè)贊

		自動(dòng)登錄	找回密碼
密碼			注冊會(huì)員