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

tg-000057

工程圖轉(zhuǎn)格式:

  v' \1 N0 q" ^# i% ?) c
  r+ X9 R$ V5 y# |# T  ^! f, yDim swApp As Object
# E) T0 z2 O" E3 l- r( U) NDim Part As Object
1 y. |( J& q7 w2 ~Dim Filename As String
! f& w6 s' o. ?& EDim No As Integer
- w, u+ C" P9 S( PDim Title As String          '以上設(shè)定變量
Sub main()
  |0 b0 E" e7 }+ k( RSet swApp = Application.SldWorks
+ d) {: l4 v$ x8 ^+ nSet Part = swApp.ActiveDoc                                                  '以上交換數(shù)據(jù)
Filename = Part.GetPathName()                                               'Filename為文件名
' C5 ], {( A" s5 I* _+ m! QNo = Len(Filename)                                                          'no為工程圖文件名字符串總數(shù)
* B# u$ J$ [, o0 C: e: ~$ JIf No > 0 Then                                                              '當(dāng)NO大于0時(shí)（轉(zhuǎn)換格式名稱(chēng)是工程圖名稱(chēng)，故要先保存工程圖才可轉(zhuǎn)換，工程圖未保存無(wú)名稱(chēng)，無(wú)字符串，不可進(jìn)行一下步)
Filename = Left(Filename, No - 7) + "." + Right(Filename, 1)                '字串符操作，no-7為去掉工程圖后綴名，"."+ right（filename,1）為增加后綴名最后一個(gè)字母作為識(shí)別，用于區(qū)別客戶(hù)來(lái)圖，可不要
, @8 d2 b- k; z1 g# O1 {6 P" |Part.SaveAs2 Filename & ".dwg", 0, True, False                              '輸出需要轉(zhuǎn)換的格式文件，已有文件則自動(dòng)替換，不提示，（有些格式文件在打開(kāi)狀態(tài)中不可替換，替換不成功也不提示)
$ R9 r9 y! W5 a! t8 XPart.SaveAs2 Filename & ".pdf", 0, True, False
End If
End Sub
+ U, S% {- o; B

6 M/ @1 k  m: J9 h( o
屬性改寫(xiě)宏:

: d5 Q2 |9 ~. u0 z
5 ~! I3 s! w. V. ?4 s6 [
6 g6 r5 d6 W4 V  I5 `Sub main()

Dim swApp As SldWorks.SldWorks
: D$ j5 m2 {9 o% P+ M  ?" n: l6 ODim swModel2 As SldWorks.ModelDoc2
$ S+ y% B7 e( _) MDim SelMgr As SldWorks.SelectionMgr
6 ~' Q, r! d* ]8 ?Dim vCustInfoNameArr2 As Variant
Dim vCustInfoName2 As Variant
$ y1 P1 a5 v' c4 W. w' l8 L7 nDim CurCFGname As Variant
" t4 G/ H, H$ rDim CurCFGnameCount As Integer
8 m7 u# g! n1 p8 L( b8 t( YDim Vnamearr As Variant
  p& Q3 E6 `9 [$ k  r- GDim CusPropMgr As CustomPropertyManager
Dim bRet As Boolean
* `$ w8 F/ B0 e- ?+ T5 Z5 jDim Vnamearr2 As Variant

Dim strmat As String
Dim tempvalue As String

, d4 Z4 q5 q6 a. q+ y8 n: S5 iSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
Set SelMgr = swModel2.SelectionManager '

Dim tg1 As String
; {$ x/ s2 L. X& Z* f3 [0 J. c7 zDim tg2 As String
: e- V. j$ S$ e7 z6 A& ODim tg3 As String
5 \" H9 Q- v( L/ S- \Dim tg4 As String
1 k  s$ k9 l+ R8 k! n& Z3 H2 }Dim tg5 As String
5 x4 g5 M" C- I7 r. z1 uDim tg6 As String
Dim tg7 As String
Dim tg8 As String
) c* j' Y0 _! \- oDim tg9 As String
7 G4 r# c# N9 ?, `Dim tg10 As String
8 ~5 o$ q! d& L0 }" a) lDim tg11 As String
Dim wm As String
Dim wm1 As Integer
. u- Y7 q" z8 UDim wm2 As String
) G4 ]4 e* O  A# K! e+ k, nDim wm3 As String
) w$ P( t3 n4 f0 {Dim wm4 As String
Dim wm5 As String
Dim wm6 As String
' f2 N7 r+ @* U0 v) D1 sDim wm7 As Integer
/ i$ o) \# v  f7 q8 s% f: o4 {Dim wm8 As String
Dim wm9 As Integer
! V7 h7 |- n# u1 _* |8 ~& DDim lz As String
% {/ v4 Z3 H2 m5 K9 MDim lz1 As Integer
' a7 m& n. A" r9 {0 U8 i$ qDim lz2 As String
* z) w2 a" k% i" f" ?Dim lz3 As String
Dim lz4 As Integer
Dim lz5 As Integer
' p9 L; L' M3 K7 z- YDim lz6 As String
Dim lz7 As Integer                                                                     '以上為設(shè)定變量
0 L( [/ g6 F: W/ O. x' ^

swApp.ActiveDoc.ActiveView.FrameState = 1
4 Q/ w0 E6 q; k0 s% s4 bvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
, i: V: e  R! z  B4 K5 H: j     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If                                                                               '此段是刪除自定屬性中的所有項(xiàng)和其項(xiàng)值
5 F  v0 \( D) T3 S  p0 g- z

! B' w" Q* Z& H" NCurCFGname = swModel2.GetConfigurationNames
CurCFGnameCount = swModel2.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
: Q1 H9 R/ x/ F: C2 W    Set CusPropMgr = swModel2.Extension.CustomPropertyManager(CurCFGname(i))
6 R. L' H0 ~- G" s4 r2 l3 k    Vnamearr = CusPropMgr.GetNames
" t& I7 U" C: ~' @    If Not IsEmpty(Vnamearr) Then
: t" s7 h0 c/ w( v! E6 M9 H        For Each Vnamearr2 In Vnamearr
            bRet = swModel2.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
; o* o5 s& O8 O9 Y5 j8 F        Next
/ y; ?; n6 C0 r    End If
" X# X5 C- l& O! ^    Next                                                                               '此斷是刪除其他配置中的屬性所有項(xiàng)和其項(xiàng)值
8 _: v1 e* L! {: ]* V1 B
( {( n4 J- t$ B+ R+ I* S
wm = swApp.ActiveDoc.GetTitle()                                                         '定義是文件名
lz = swApp.ActiveDoc.GetPathName()                                                      '定義為文件路徑
tg6 = Chr(34) + Trim("SW-Material" + "@") + wm + Chr(34)                                '定義材料屬性
, I; a" T6 H; V: ?5 N7 o, ptg7 = 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) + "㎡"                      '定義表面積屬性
bRet = swModel2.DeleteCustomInfo2("", "圖號(hào)")
bRet = swModel2.DeleteCustomInfo2("", "Description")
4 n3 i: O9 a/ C& Y$ m

wm1 = InStrRev(wm, " ") - 1                                                              '引號(hào)內(nèi)為空格，為圖名分離符號(hào)        '從右向左搜索到第一個(gè)" "符號(hào)為第幾個(gè)字串符
If wm1 > 0 Then                                                                          '當(dāng)mw1大于0量時(shí)
0 Z# B, v$ D' b    wm2 = Left(wm, wm1)                                                                  'wm2等于從wm的左側(cè)開(kāi)始提取mw1個(gè)字符
    wm3 = Left(LTrim(wm), 3)                                                             'wm等于wm去除左側(cè)無(wú)效字符的左前三個(gè)字符
    If wm3 = "GBT" Then                                                                  '當(dāng)wm3等于"GBT"時(shí)
        wm4 = "GB/T" + Mid(wm2, 4)                                                       'wm4等于"GB/T"和wm2的第4個(gè)和后面的所有字符              '當(dāng)零件是國(guó)標(biāo)時(shí)添加國(guó)標(biāo)號(hào)，文件名中/是非法字符
    Else
        wm4 = wm2                                                                         '否則wm4等wm2           '空格前面是圖號(hào)
    End If
3 ?; F8 [6 R2 ~: p( S$ ^  I' V
$ N6 i; H0 R$ ~7 j6 A# C    wm5 = Mid(wm, wm1 + 2)                                                                'wm5等于wm中的第wm1+2個(gè)后面的所有字符
* ^0 w1 F4 I8 j8 _( t: J    wm6 = Right(wm, 7)                                                                    'wm6等于wm最后面的7個(gè)字符
/ \% q  A4 C& ?% j, h8 |6 U5 X    If wm6 = ".SLDPRT" Or wm6 = ".SLDASM" Or wm6 = ".sldprt" Or wm6 = ".sldasm" Then      '當(dāng)wm6等于這4個(gè)值時(shí)
4 b# F( L0 n8 B& T" x        wm7 = Len(wm5) - 7                                                                'wm7等于wm5的所有字符數(shù)-7
0 O8 }) ~8 J' m9 Z( }! Z* v    Else
        wm7 = Len(wm5)                                                                    '否則wm7等于wm5的所有字符數(shù)
6 Q$ f6 s) F7 N! h+ |) R: i3 A+ J    End If
! V. Q# N! I* e6 t+ l0 J- d9 J' F$ M9 U2 j    tg5 = Left(wm5, wm7)                                                                  'tg5等于wm5左側(cè)的wm7個(gè)字符          ,空格后面是名稱(chēng)，有后綴名并去掉后綴名，無(wú)后綴后（文件未保存時(shí))直接上檔

* w' L2 ]4 X9 s0 t. J1 W! z1 B! bEnd If                                                                                                                       '此段為圖名分離定義
# Q7 j% Y6 L/ H$ U0 ]$ ^

9 G* U+ m6 E, S2 T$ j6 _If wm1 > 0 Then                                                                           '當(dāng)wm1大于0時(shí)
tg4 = wm4                                                                                 'tg4等于wm4              '文件名有空格時(shí)，圖號(hào)為分離出來(lái)圖號(hào)
Else
    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í)
$ C# _+ Y( i  A, D  C# _( d        wm9 = Len(wm) - 7                                                                 'wm9等于wm的所有字符數(shù)-7
8 n* g3 v4 {4 x3 [% E# W5 R( s    Else
        wm9 = Len(wm)
    End If                                                                                '否則wm9等于wm所有字符數(shù)-7
tg4 = Left(wm, wm9)                                                                       'tg4等于wm左側(cè)的wm9個(gè)字符    '文件無(wú)空格時(shí)，文件名即是圖號(hào)，并去掉后綴名,無(wú)后綴名（文件未保存時(shí))直接上檔
End If                                                                                                                        '此段為非圖號(hào)名稱(chēng)命名文件，將文件名加到圖號(hào)屬性
0 `* p! v5 h3 T& @# Z'例，fgq01-001 前門(mén)板：分離后圖號(hào)（fgq-001），名稱(chēng)（前門(mén)板)
'例，fgq01-001 前 門(mén)板：分離后圖號(hào)（fgq-001 前），名稱(chēng)（門(mén)板)
'例，fgq01-001-前門(mén)板：分離后圖號(hào)（fgq-001-前門(mén)板），名稱(chēng)為空
'以最后一個(gè)空格為準(zhǔn)分離


lz1 = 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è)字符
. ~: I1 Q5 y+ L* Ilz3 = Mid(lz, lz1 + 2)                                                                   'lz3等于lz的第lz2+2個(gè)后其后面所有字符
) m6 @; k; t6 V" E! [- \6 x- [lz4 = InStrRev(lz2, "\")                                                                 'lz4為lz2由后向前搜索到第一個(gè)"\"字符在第幾個(gè)
lz5 = InStr(lz3, "\")                                                                    'lz5為lz2由前向后搜索到第一個(gè)"\"字符在第幾個(gè)
tg1 = Mid(lz2, lz4 + 1)                                                                  'tg1等于lz2的第lz4+1個(gè)后面的所有字符
'tg1 = Right(lz2, 8 - lz4)                                                               'tg1等于lz2右側(cè)的8-lz4個(gè)字符(lz2總字符為8個(gè))
0 I7 S/ L; I; A& R+ g9 l8 etg2 = Left(lz3, lz5 - 1)                                                                 'tg2等于lz3左側(cè)的lz5-1個(gè)字符
% }9 |4 S- U# D! [" f
, A7 e8 e4 j3 \; p! Ulz6 = Mid(lz3, lz5 + 1)                                                                  'lz6等于lz3第lz5+1個(gè)后面的所有字符
/ \1 _; j$ q1 z' O- B6 \9 D, Ulz7 = InStr(lz6, "\")                                                                    'lz7為lz6由左向右搜索出第一個(gè)"\"字符在第幾個(gè)
# H; i/ k! T6 i& p5 `! u/ fIf lz7 > 0 Then                                                                          '當(dāng)lz7大于0時(shí)
tg3 = Left(lz6, lz7 - 1)                                                                 'tg3等于lz6左側(cè)的lz7-1個(gè)字符
End If
End If                                                                                    '此段為文件路徑提取項(xiàng)目號(hào)
'例，零件文件完整路徑為：E:\工作文檔\B-非標(biāo)產(chǎn)品\非標(biāo)--F類(lèi)\FGQ--定制角架\2020版\前門(mén)板.SLDPRT
- J5 H+ s2 p% W9 D( i  C4 z, k4 M  i'由后向前搜索“--”,第一個(gè)“--”向前到“\”間為產(chǎn)品編號(hào)（FGQ），向后到“\”間為產(chǎn)品名稱(chēng)（定制角架），向后的第一個(gè)“\”和第二個(gè)間“\”，為版本號(hào)(2020版)。



- d% a. m* z3 e. A3 k9 L7 D; J, fbRet = swModel2.AddCustomInfo3("", "產(chǎn)品編號(hào)", swCustomInfoText, tg1)
; N0 r1 d9 K* s4 hbRet = swModel2.AddCustomInfo3("", "產(chǎn)品名稱(chēng)", swCustomInfoText, tg2)
# h: [$ |1 p6 G+ FbRet = swModel2.AddCustomInfo3("", "版本號(hào)", swCustomInfoText, tg3)
! q1 Y+ w. W% E2 D/ V# {6 N, [* WbRet = swModel2.AddCustomInfo3("", "圖號(hào)", swCustomInfoText, tg4)
bRet = swModel2.AddCustomInfo3("", "Description", swCustomInfoText, tg5)
+ c) p# G% n4 [; U" I7 U# _/ K  ObRet = swModel2.AddCustomInfo3("", "數(shù)量", swCustomInfoText, "1")
9 s5 E$ p. m0 Z7 FbRet = swModel2.AddCustomInfo3("", "備注1", swCustomInfoText, " ")
bRet = swModel2.AddCustomInfo3("", "備注2", swCustomInfoText, " ")
- C2 ~7 X3 f7 Y$ R5 L1 `6 x. rbRet = swModel2.AddCustomInfo3("", "備注3", swCustomInfoText, " ")
/ h# A8 S: F/ J0 q% P/ f. vbRet = swModel2.AddCustomInfo3("", "Material", swCustomInfoText, tg6)
bRet = swModel2.AddCustomInfo3("", "SH", swCustomInfoText, tg7)
bRet = swModel2.AddCustomInfo3("", "重量", swCustomInfoText, tg8)
bRet = swModel2.AddCustomInfo3("", "表面積", swCustomInfoText, tg9)                         '此段為填寫(xiě)自定義屬性項(xiàng)與其值
; z6 n+ w% u  @! l6 o
, w* P6 P- K& o) l6 fDim thisFeat As SldWorks.Feature                                                         '另外增加一段宏，取讀取切割清單數(shù)據(jù)，并添加到屬性項(xiàng)。
6 K5 q- k- B  u; Y/ W# u# A; sDim thisSubFeat As SldWorks.Feature
) g8 ~3 R/ k+ o' q; ZDim cutFolder As Object
3 N4 Q  @1 i  n! n" dDim BodyCount As Integer
# f1 w+ `2 J0 i/ d  ~, S# yDim custPropMgr As SldWorks.CustomPropertyManager
Dim propNames As Variant
% P2 @6 {' }0 dDim vName As Variant
Dim propName As String
. X' T5 U1 z( m5 _4 ^' j0 JDim Value As String
Dim resolvedValue As String
; D. o) M: m5 {/ J8 m* b/ m2 @" ZDim bjkcd As Double
5 |& w4 v3 e8 P+ WDim bjkkd As Double
2 [, {8 w/ V& J* v9 k3 c'Sub main()
'Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
3 u9 k, v5 F2 |% o1 \Set thisFeat = Part.FirstFeature
5 ?0 x! F$ g9 nDo While Not thisFeat Is Nothing '遍歷設(shè)計(jì)樹(shù)
If thisFeat.GetTypeName = "SolidBodyFolder" Then
  b  ]2 k# C5 t* R+ Q. tthisFeat.GetSpecificFeature2.UpdateCutList
/ ]! {+ T/ t! ^  K* |End If
Set thisSubFeat = thisFeat.GetFirstSubFeature
$ q2 q& U) i1 ?4 d- O6 SDo While Not thisSubFeat Is Nothing
If thisSubFeat.GetTypeName = "CutListFolder" Then '查找切割清單
Set cutFolder = thisSubFeat.GetSpecificFeature2
End If
# `0 D8 b0 `, g" g) vIf Not cutFolder Is Nothing Then
* X8 X/ B9 F( L8 P! n6 HBodyCount = cutFolder.GetBodyCount
: G4 N: Q; p- RIf BodyCount > 0 Then
Set custPropMgr = thisSubFeat.CustomPropertyManager
If Not custPropMgr Is Nothing Then
7 X0 }3 F2 z% ?0 z" r! t6 EpropNames = custPropMgr.GetNames '獲取切割清單屬性的數(shù)據(jù)全部名稱(chēng)并放入數(shù)組
If Not IsEmpty(propNames) Then
+ F7 d, c  k  P0 j  @4 xFor Each vName In propNames
' u& ]+ J+ m" Z% ^+ ]8 U/ N: c% NpropName = vName
5 v3 F9 b' S5 f- ^6 L- P, ~) wcustPropMgr.Get2 propName, Value, resolvedValue '獲取全部屬性名稱(chēng) ，數(shù)值和評(píng)估的值
  |( r* P9 H0 EIf propName = "邊界框長(zhǎng)度" Then bjkcd = resolvedValue '判斷是否是自己所需要的數(shù)據(jù)，如果是就獲取
9 R' P! ?+ [& U- gIf propName = "邊界框?qū)挾?quot; Then bjkkd = resolvedValue
Next vName
End If
7 P2 T" O, k6 ]End If
End If
End If
5 T: x$ Z3 _  E/ O1 e& Y: \' JSet thisSubFeat = thisSubFeat.GetNextSubFeature
. r8 l0 s' n3 nLoop
) X4 q, I* g& B2 ASet thisFeat = thisFeat.GetNextFeature
$ h& P, H, C5 SLoop
'blnretval = Part.DeleteCustomInfo2("", "邊界框長(zhǎng)度") '刪除屬性欄上摘要信息的數(shù)據(jù)
'blnretval = Part.DeleteCustomInfo2("", "邊界框?qū)挾?quot;)
blnretval = Part.AddCustomInfo3("", "開(kāi)料長(zhǎng)度", swCustomInfoText, bjkcd) '添加數(shù)據(jù)到摘要信息
blnretval = Part.AddCustomInfo3("", "開(kāi)料寬度", swCustomInfoText, bjkkd)
) n5 N0 f4 H  L2 L+ K5 q/ Q( ^
; Y4 T" z7 N( ?, j9 vEnd Sub

遠(yuǎn)祥

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

曉昀

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

柴榮1917

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

tg-000057

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

" H+ L6 I9 B8 X1 ^, @$ fcad轉(zhuǎn)PDF，用cad的PDF打印機(jī)就行了，這個(gè)是sw轉(zhuǎn)dwg，dxf，和pdf等格式的。

meltemi

學(xué)習(xí)一下，