分享兩個(gè)宏,，有詳細(xì)注解,，可盡情修改使用,，代碼也一起放了。

tg-000057

+ P( }2 t2 Q% y  Z  }: f工程圖轉(zhuǎn)格式:
# }1 F; B. a. L$ ]

# O7 O7 a) T( G/ O& sDim swApp As Object
Dim Part As Object
4 C9 H& f/ Z8 f  \& _+ bDim Filename As String
Dim No As Integer
$ e: A7 s0 u  ~Dim Title As String          '以上設(shè)定變量
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc                                                  '以上交換數(shù)據(jù)
Filename = Part.GetPathName()                                               'Filename為文件名
+ v3 D1 U! t0 E0 iNo = Len(Filename)                                                          'no為工程圖文件名字符串總數(shù)
If No > 0 Then                                                              '當(dāng)NO大于0時(shí)（轉(zhuǎn)換格式名稱是工程圖名稱,，故要先保存工程圖才可轉(zhuǎn)換,，工程圖未保存無名稱，無字符串,，不可進(jìn)行一下步)
2 k3 \8 O7 M$ O8 J, e# FFilename = Left(Filename, No - 7) + "." + Right(Filename, 1)                '字串符操作,，no-7為去掉工程圖后綴名，"."+ right（filename,1）為增加后綴名最后一個(gè)字母作為識別,，用于區(qū)別客戶來圖,，可不要
  @4 w, y8 s, i  r/ l+ @Part.SaveAs2 Filename & ".dwg", 0, True, False                              '輸出需要轉(zhuǎn)換的格式文件，已有文件則自動(dòng)替換,，不提示，（有些格式文件在打開狀態(tài)中不可替換,，替換不成功也不提示)
Part.SaveAs2 Filename & ".pdf", 0, True, False
End If
0 w7 S% i  s( u7 IEnd Sub
" L! V( F1 _: o" P8 \2 L4 [& f
/ c0 u, }& ]" r# D6 ~! f
- p: Y! a& _* V6 \5 h3 m- F
1 W% K' S/ y7 v! k/ h2 H+ Y) P0 u3 G屬性改寫宏:

. j/ v" \: z1 M0 n  @, ?1 u

Sub main()
0 o$ E( ~. w: _! n
Dim swApp As SldWorks.SldWorks
+ n  e, k+ Z2 |4 l3 @- tDim swModel2 As SldWorks.ModelDoc2
; D6 G! ?  K3 j+ wDim SelMgr As SldWorks.SelectionMgr
Dim vCustInfoNameArr2 As Variant
2 p4 K4 b4 s3 |: _9 n% |- ZDim vCustInfoName2 As Variant
Dim CurCFGname As Variant
  o3 s- K- e5 {6 S  P9 S! ^* y) ^- W, VDim CurCFGnameCount As Integer
Dim Vnamearr As Variant
- P- H1 w* h5 M- j8 n" y: }) tDim CusPropMgr As CustomPropertyManager
Dim bRet As Boolean
Dim Vnamearr2 As Variant

5 `' B8 B( o& xDim strmat As String
Dim tempvalue As String

* v( K: L7 `3 YSet swApp = Application.SldWorks
) m5 R5 w. e! b9 k' k+ ?6 uSet swModel2 = swApp.ActiveDoc
Set SelMgr = swModel2.SelectionManager '
  q8 {: X5 G; b2 L- J
Dim tg1 As String
9 i8 L, n1 `2 w8 Q5 oDim tg2 As String
' b* u; e5 H( k, U5 H; [) nDim tg3 As String
7 f/ c, T+ F9 a/ ADim tg4 As String
Dim tg5 As String
$ H$ k) v& K) v  M) I6 N& n+ o' KDim tg6 As String
Dim tg7 As String
Dim tg8 As String
Dim tg9 As String
* n. O5 o) h* h) HDim tg10 As String
1 K! o, d4 C3 W, m* DDim tg11 As String
' [; ]' P! P5 D6 @/ T0 b2 C! HDim wm As String
5 S  C5 R/ _9 O. xDim wm1 As Integer
Dim wm2 As String
Dim wm3 As String
* g6 m  I3 {3 h8 l* kDim wm4 As String
  G: y% i8 I7 EDim wm5 As String
Dim wm6 As String
Dim wm7 As Integer
; b8 x' J9 H+ ~Dim wm8 As String
Dim wm9 As Integer
) {$ X  M# D3 i& O8 ~Dim lz As String
Dim lz1 As Integer
6 r% k+ s2 `: u5 K( N/ CDim lz2 As String
; e4 M# M9 x# B& hDim lz3 As String
$ I% p' o+ `: |$ \Dim lz4 As Integer
Dim lz5 As Integer
Dim lz6 As String
% Z; }- \" j& l0 h8 ZDim lz7 As Integer                                                                     '以上為設(shè)定變量
5 h+ {( @  U. p7 @/ ~5 L9 J3 Z
3 V5 w; q+ y. F( J" E+ Y
# D' ~9 O' ~, e1 uswApp.ActiveDoc.ActiveView.FrameState = 1
; [( w# d+ R2 {9 E$ C5 [. G( s" ivCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
' ^+ H- V+ Y  i' }% C& n+ T: v     For Each vCustInfoName2 In vCustInfoNameArr2
& G( F- p. n9 N3 P% |         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
3 o  p# z5 p) d  f& }9 f! {      Next
+ q4 r" ^6 W) \8 d! X8 W( v0 d  End If                                                                               '此段是刪除自定屬性中的所有項(xiàng)和其項(xiàng)值


CurCFGname = swModel2.GetConfigurationNames
CurCFGnameCount = swModel2.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = swModel2.Extension.CustomPropertyManager(CurCFGname(i))
' |, ?; Y2 t8 ^0 S, T5 _    Vnamearr = CusPropMgr.GetNames
! N6 {  C( t2 N6 X! t6 v    If Not IsEmpty(Vnamearr) Then
/ D) H  h4 L' b5 A2 b- v        For Each Vnamearr2 In Vnamearr
0 N7 _# y# l3 S: E; E# H            bRet = swModel2.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
* i7 f$ A: g3 _- q    End If
    Next                                                                               '此斷是刪除其他配置中的屬性所有項(xiàng)和其項(xiàng)值
; `" P) i0 v% f5 Z3 N! U
+ e6 `- P% S) k2 I& S; l
2 w& b7 w% S% E+ j( uwm = swApp.ActiveDoc.GetTitle()                                                         '定義是文件名
1 I8 d/ X7 K9 V2 R8 {- llz = swApp.ActiveDoc.GetPathName()                                                      '定義為文件路徑
tg6 = Chr(34) + Trim("SW-Material" + "@") + wm + Chr(34)                                '定義材料屬性
4 `: u1 j  x: t+ X6 S7 z, n8 y- Ntg7 = Chr(34) + Trim("厚度" + "@") + wm + Chr(34)                                       '定義鈑金厚度屬性
tg8 = Chr(34) + Trim("SW-Mass" + "@") + wm + Chr(34) + "kg"                             '定義質(zhì)量屬性
tg9 = Chr(34) + Trim("SW-SurfaceArea" + "@") + wm + Chr(34) + "㎡"                      '定義表面積屬性
# ?0 ]1 E! f' O* bbRet = swModel2.DeleteCustomInfo2("", "圖號")
bRet = swModel2.DeleteCustomInfo2("", "Description")


wm1 = InStrRev(wm, " ") - 1                                                              '引號內(nèi)為空格,，為圖名分離符號        '從右向左搜索到第一個(gè)" "符號為第幾個(gè)字串符
If wm1 > 0 Then                                                                          '當(dāng)mw1大于0量時(shí)
    wm2 = Left(wm, wm1)                                                                  'wm2等于從wm的左側(cè)開始提取mw1個(gè)字符
' s2 q4 w% j9 c6 j  ]    wm3 = Left(LTrim(wm), 3)                                                             'wm等于wm去除左側(cè)無效字符的左前三個(gè)字符
  _9 l0 p' g* z; E4 q    If wm3 = "GBT" Then                                                                  '當(dāng)wm3等于"GBT"時(shí)
        wm4 = "GB/T" + Mid(wm2, 4)                                                       'wm4等于"GB/T"和wm2的第4個(gè)和后面的所有字符              '當(dāng)零件是國標(biāo)時(shí)添加國標(biāo)號，文件名中/是非法字符
4 \; n: r. }9 v- \- J: @    Else
: p$ J" C& x0 c: |        wm4 = wm2                                                                         '否則wm4等wm2           '空格前面是圖號
    End If
1 a9 O/ w& l8 W4 j
    wm5 = Mid(wm, wm1 + 2)                                                                'wm5等于wm中的第wm1+2個(gè)后面的所有字符
    wm6 = Right(wm, 7)                                                                    'wm6等于wm最后面的7個(gè)字符
2 i5 T5 D2 u$ Y* {0 u" U    If wm6 = ".SLDPRT" Or wm6 = ".SLDASM" Or wm6 = ".sldprt" Or wm6 = ".sldasm" Then      '當(dāng)wm6等于這4個(gè)值時(shí)
        wm7 = Len(wm5) - 7                                                                'wm7等于wm5的所有字符數(shù)-7
    Else
# j8 `$ r1 n2 ?1 V$ b5 k. `        wm7 = Len(wm5)                                                                    '否則wm7等于wm5的所有字符數(shù)
6 O( W8 r# i# J2 I' Y3 }    End If
    tg5 = Left(wm5, wm7)                                                                  'tg5等于wm5左側(cè)的wm7個(gè)字符          ,空格后面是名稱,，有后綴名并去掉后綴名,，無后綴后（文件未保存時(shí))直接上檔
- ^0 ]4 _( _2 V  R% P% Q8 c
End If                                                                                                                       '此段為圖名分離定義


6 k  _+ }$ S6 o0 ^. s! ^If wm1 > 0 Then                                                                           '當(dāng)wm1大于0時(shí)
, n+ {8 m' s# g4 }6 i5 g- ^7 [tg4 = wm4                                                                                 'tg4等于wm4              '文件名有空格時(shí)，圖號為分離出來圖號
Else
, F" u! Z% e$ W3 F% ?0 H: E. U    wm8 = Right(wm, 7)                                                                    'wm8等于wm最后面的7個(gè)字符
    If wm8 = ".SLDPRT" Or wm8 = ".SLDASM" Or wm8 = ".sldprt" Or wm8 = ".sldasm" Then      '當(dāng)wm8等于這4個(gè)值時(shí)
: D/ U& @6 u( ^* w, Q- W9 g4 n        wm9 = Len(wm) - 7                                                                 'wm9等于wm的所有字符數(shù)-7
" g& T+ {, V/ q, A    Else
; P3 X% P8 m4 A9 x# e; E        wm9 = Len(wm)
    End If                                                                                '否則wm9等于wm所有字符數(shù)-7
4 R- x$ z/ [2 Ttg4 = Left(wm, wm9)                                                                       'tg4等于wm左側(cè)的wm9個(gè)字符    '文件無空格時(shí),，文件名即是圖號,，并去掉后綴名,無后綴名（文件未保存時(shí))直接上檔
7 }( ^0 O, y& cEnd If                                                                                                                        '此段為非圖號名稱命名文件，將文件名加到圖號屬性
'例,，fgq01-001 前門板：分離后圖號（fgq-001）,，名稱（前門板)
; O! I8 L; J; T0 |'例，fgq01-001 前 門板：分離后圖號（fgq-001 前）,，名稱（門板)
'例,，fgq01-001-前門板：分離后圖號（fgq-001-前門板），名稱為空
8 f# F; C% H1 i* g: k2 Z* k0 p'以最后一個(gè)空格為準(zhǔn)分離
$ B' W0 `. i1 h7 X+ |8 s5 D: P) e

7 [' [( O# P0 l& r2 C  T+ Glz1 = InStrRev(lz, "--")                                                                 'lz1為lz由后向前搜索到第一個(gè)"--"字符在第幾個(gè)
If lz1 > 0 Then                                                                          '當(dāng)lz1大于0時(shí)
lz2 = Mid(lz, lz1 - 8, 8)                                                                'lz2等于lz的第lz1-8個(gè)和其后面8個(gè)字符
3 ]- S! R+ U0 n. E# e/ l& Olz3 = Mid(lz, lz1 + 2)                                                                   'lz3等于lz的第lz2+2個(gè)后其后面所有字符
. ?* ]& r& j, {1 ^5 _( n! n+ mlz4 = InStrRev(lz2, "\")                                                                 'lz4為lz2由后向前搜索到第一個(gè)"\"字符在第幾個(gè)
: r3 S5 M8 `" x* k; q- Tlz5 = InStr(lz3, "\")                                                                    'lz5為lz2由前向后搜索到第一個(gè)"\"字符在第幾個(gè)
- M% J; a: ]+ G2 E! Wtg1 = Mid(lz2, lz4 + 1)                                                                  'tg1等于lz2的第lz4+1個(gè)后面的所有字符
'tg1 = Right(lz2, 8 - lz4)                                                               'tg1等于lz2右側(cè)的8-lz4個(gè)字符(lz2總字符為8個(gè))
6 H! s9 t* k9 M8 }tg2 = Left(lz3, lz5 - 1)                                                                 'tg2等于lz3左側(cè)的lz5-1個(gè)字符

( n  W; U* M0 a- |lz6 = Mid(lz3, lz5 + 1)                                                                  'lz6等于lz3第lz5+1個(gè)后面的所有字符
lz7 = InStr(lz6, "\")                                                                    'lz7為lz6由左向右搜索出第一個(gè)"\"字符在第幾個(gè)
2 m/ }0 K, h0 u! ~* A2 T7 `0 wIf lz7 > 0 Then                                                                          '當(dāng)lz7大于0時(shí)
tg3 = Left(lz6, lz7 - 1)                                                                 'tg3等于lz6左側(cè)的lz7-1個(gè)字符
End If
; i( P; I" b; d9 |8 P/ r" Z8 oEnd If                                                                                    '此段為文件路徑提取項(xiàng)目號
'例,，零件文件完整路徑為：E:\工作文檔\B-非標(biāo)產(chǎn)品\非標(biāo)--F類\FGQ--定制角架\2020版\前門板.SLDPRT
'由后向前搜索“--”,第一個(gè)“--”向前到“\”間為產(chǎn)品編號（FGQ）,，向后到“\”間為產(chǎn)品名稱（定制角架），向后的第一個(gè)“\”和第二個(gè)間“\”,，為版本號(2020版),。



bRet = swModel2.AddCustomInfo3("", "產(chǎn)品編號", swCustomInfoText, tg1)
bRet = swModel2.AddCustomInfo3("", "產(chǎn)品名稱", swCustomInfoText, tg2)
7 ~$ W. v, r# pbRet = swModel2.AddCustomInfo3("", "版本號", swCustomInfoText, tg3)
8 \1 m* A" l. P% D2 }bRet = swModel2.AddCustomInfo3("", "圖號", swCustomInfoText, tg4)
  n9 d; a2 ]5 S6 m8 b6 @bRet = swModel2.AddCustomInfo3("", "Description", swCustomInfoText, tg5)
  ~$ ]! a- g6 ~3 m+ w8 p3 sbRet = swModel2.AddCustomInfo3("", "數(shù)量", swCustomInfoText, "1")
5 s' ^  t8 {0 sbRet = swModel2.AddCustomInfo3("", "備注1", swCustomInfoText, " ")
9 {! J( F1 D7 l; DbRet = swModel2.AddCustomInfo3("", "備注2", swCustomInfoText, " ")
) t9 E& ?6 B6 ]. x$ P& d2 {bRet = swModel2.AddCustomInfo3("", "備注3", swCustomInfoText, " ")
bRet = swModel2.AddCustomInfo3("", "Material", swCustomInfoText, tg6)
bRet = swModel2.AddCustomInfo3("", "SH", swCustomInfoText, tg7)
; _: [  @1 b6 |" |( jbRet = swModel2.AddCustomInfo3("", "重量", swCustomInfoText, tg8)
bRet = swModel2.AddCustomInfo3("", "表面積", swCustomInfoText, tg9)                         '此段為填寫自定義屬性項(xiàng)與其值
+ q! v5 z2 u/ Z4 K) o
Dim thisFeat As SldWorks.Feature                                                         '另外增加一段宏,，取讀取切割清單數(shù)據(jù)，并添加到屬性項(xiàng),。
' L5 o% U/ d9 j1 SDim thisSubFeat As SldWorks.Feature
Dim cutFolder As Object
Dim BodyCount As Integer
- _0 l7 e" ]2 CDim custPropMgr As SldWorks.CustomPropertyManager
Dim propNames As Variant
Dim vName As Variant
Dim propName As String
Dim Value As String
Dim resolvedValue As String
! @' Z9 N7 a" q; s4 M9 eDim bjkcd As Double
Dim bjkkd As Double
'Sub main()
2 W( i' d) _$ \'Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
# F; Z( A" \$ f3 n% H' r9 q- ASet thisFeat = Part.FirstFeature
( T. T2 m! R& w, o' w, @) T( m+ N1 QDo While Not thisFeat Is Nothing '遍歷設(shè)計(jì)樹
If thisFeat.GetTypeName = "SolidBodyFolder" Then
thisFeat.GetSpecificFeature2.UpdateCutList
# I( c/ T8 B% K* t5 Y0 [8 lEnd If
Set thisSubFeat = thisFeat.GetFirstSubFeature
3 q) k* h) J  M5 gDo While Not thisSubFeat Is Nothing
& ~5 Y6 g0 T4 V1 }) jIf thisSubFeat.GetTypeName = "CutListFolder" Then '查找切割清單
Set cutFolder = thisSubFeat.GetSpecificFeature2
. J8 G& ?# ?2 u: KEnd If
6 g/ i  t7 h2 j* z5 K/ M) m8 }If Not cutFolder Is Nothing Then
! E7 U  I. z2 m" _0 p5 ABodyCount = cutFolder.GetBodyCount
If BodyCount > 0 Then
Set custPropMgr = thisSubFeat.CustomPropertyManager
If Not custPropMgr Is Nothing Then
8 C/ g2 Z2 b4 }8 BpropNames = custPropMgr.GetNames '獲取切割清單屬性的數(shù)據(jù)全部名稱并放入數(shù)組
If Not IsEmpty(propNames) Then
For Each vName In propNames
propName = vName
5 }) U2 e" X, x+ ecustPropMgr.Get2 propName, Value, resolvedValue '獲取全部屬性名稱 ,，數(shù)值和評估的值
4 k1 i" O, `" w8 L! |8 YIf propName = "邊界框長度" Then bjkcd = resolvedValue '判斷是否是自己所需要的數(shù)據(jù)，如果是就獲取
If propName = "邊界框?qū)挾?quot; Then bjkkd = resolvedValue
! e) g. {, C9 p7 x* P6 ?: g+ iNext vName
End If
End If
End If
End If
Set thisSubFeat = thisSubFeat.GetNextSubFeature
Loop
Set thisFeat = thisFeat.GetNextFeature
Loop
'blnretval = Part.DeleteCustomInfo2("", "邊界框長度") '刪除屬性欄上摘要信息的數(shù)據(jù)
9 K% \' s" I0 d/ ['blnretval = Part.DeleteCustomInfo2("", "邊界框?qū)挾?quot;)
( @& U# [( ]6 Mblnretval = Part.AddCustomInfo3("", "開料長度", swCustomInfoText, bjkcd) '添加數(shù)據(jù)到摘要信息
blnretval = Part.AddCustomInfo3("", "開料寬度", swCustomInfoText, bjkkd)

* J& q/ U" R& uEnd Sub
2 U+ @' r5 n# R, I- `6 i& d
* j6 ?8 n" ^" J2 F( i

遠(yuǎn)祥

挺復(fù)雜啊，比較難用吧,？,？

曉昀

這個(gè)是不是CAD轉(zhuǎn)pdf的？佩服做軟件二次開發(fā)的人,。

柴榮1917

學(xué)習(xí)一下,。

tg-000057

曉昀 發(fā)表于 2021-1-13 17:17
這個(gè)是不是CAD轉(zhuǎn)pdf的？佩服做軟件二次開發(fā)的人,。

cad轉(zhuǎn)PDF,，用cad的PDF打印機(jī)就行了，這個(gè)是sw轉(zhuǎn)dwg,，dxf,，和pdf等格式的。
6 W( m, V# z; y3 Q/ d- Z8 |  U