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

響在江湖

DaveChan 發(fā)表于 2016-10-4 08:22
" N6 \* j! D' P( Q4 [. K給你兩個(gè)函數(shù)參考
可以自己查找API
這兩個(gè)函數(shù)都可以實(shí)現(xiàn)你要的功能

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

DaveChan

響在江湖 發(fā)表于 2016-10-13 20:09
) m) Y# w) N$ `( Y% j7 S) _首先感謝社友回復(fù)，不過(guò)你發(fā)的這個(gè)怎么復(fù)制到txt中呀？復(fù)制代碼后只有“”ExportToDWG“這個(gè)。
還有API ...

6 w: }7 Q% v  }( ~6 P" S. J稍微修改了幫助文件里面的代碼代碼如下

1. Option Explicit
   
2. Dim swApp As SldWorks.SldWorks
   
3. Dim swModel As SldWorks.ModelDoc2
   . p( Y& q; F5 _- x8 `( A! q8 f6 [
4. Dim swModelDocExt As SldWorks.ModelDocExtension
   0 K: _. s! L1 X7 E: E( {" {
5. Dim FileName As String
   0 d8 v8 }0 C) q8 M  M  |# E& |3 W- N
6. Dim NewName As String
   ' k& D0 b" F8 @8 w5 ~( D7 ?& G" s0 u
7. Dim boolstatus As Boolean
   
8. Dim longstatus As Long, longwarnings As Long
   
9. Sub main()
   
10. Set swApp = Application.SldWorks
    
11. Set swModel = swApp.ActiveDoc
    
12. Set swModelDocExt = swModel.Extension
    
13. FileName = swModel.GetPathName()
    " {# R) C/ I. @( c) q
14. NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
    
15. boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_None)
    
16. swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
    + k& U# @/ K- u- D9 ]' E
17. End Sub
      a7 o0 o" f5 [5 P

復(fù)制代碼

! K% T$ [7 H4 _/ Q% o

響在江湖

DaveChan 發(fā)表于 2016-10-13 21:17
& \. D) u# O" _稍微修改了幫助文件里面的代碼代碼如下

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

DaveChan

響在江湖 發(fā)表于 2016-10-20 21:47
社區(qū)果然有高手存在��！為社區(qū)有這樣為人解惑的人存在感到欣慰！真心感謝為我解決頭疼的問(wèn)題，不過(guò)因?yàn)槭?...

5 g8 ~& }% y/ Z4 s! h3 ?0 M8 n移除折彎線代碼如下：

1. Option Explicit
   7 F% ^+ I; J2 d# d
2. Dim swApp As SldWorks.SldWorks
   ! d( Z- W  |; U. `3 ?; [& n' p
3. Dim swModel As SldWorks.ModelDoc2
   * ~# l' j* A7 K% R
4. Dim swModelDocExt As SldWorks.ModelDocExtension
   6 d  A) }7 i2 K  E; n$ z' g$ n
5. Dim FileName As String
   6 p9 R" f/ M. m/ V9 G; H
6. Dim NewName As String
   
7. Dim boolstatus As Boolean
   
8. Dim longstatus As Long, longwarnings As Long
   + L/ _+ B  E/ m& t
9. Sub main()
   
10. Set swApp = Application.SldWorks
    ! y# F, ^& H0 J! {' v& y
11. Set swModel = swApp.ActiveDoc
    
12. Set swModelDocExt = swModel.Extension
    
13. FileName = swModel.GetPathName()
    7 V# X9 Z8 C0 n- M6 a
14. NewName = Left(FileName, Len(FileName) - 7) & ".dwg"
    
15. boolstatus = swModel.ExportFlatPatternView(NewName, swExportFlatPatternOption_RemoveBends)
    
16. swModelDocExt.SaveAs NewName, 0, 0, Nothing, longstatus, longwarnings
    
17. End Sub
    3 B  M4 t0 j% [; R4 S& l1 K

復(fù)制代碼

tyne1314

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

響在江湖

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

我試試啊
5 T, ^2 p8 d8 [: e6 m! a

響在江湖

DaveChan 發(fā)表于 2016-10-21 13:49
移除折彎線代碼如下：

太牛了！真心感謝，應(yīng)社友要求共享該程序不知這個(gè)借花獻(xiàn)佛可以不？呵呵
5 P4 D& O' g2 F" \3 \+ M

響在江湖

tyne1314 發(fā)表于 2016-10-22 14:03
5 U' `6 }( E4 h能把這個(gè)宏分享一下么？這可以方便做鈑金展開的朋友們呀，謝謝

9 `- ^; r/ H1 U- ]6 \你是專門學(xué)過(guò)VB嗎？還是也是錄制的宏程序？

DaveChan

響在江湖 發(fā)表于 2016-10-23 10:27
* j/ k. A% |- `! E2 ~你是專門學(xué)過(guò)VB嗎？還是也是錄制的宏程序？

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

6 b) D2 c2 F% |我編程只是業(yè)余愛好而已，不專業(yè)
4 X" A# v, O/ c6 W

leilei333

頂一萬(wàn)個(gè)贊