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

tg-000057

工程圖轉格式:
* D4 T/ P  \' D4 p: P" l( z3 d

3 k8 t$ o1 u( h1 ~$ C% HDim swApp As Object
" X( B. G; E0 ?) e4 iDim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String          '以上設定變量
; K2 q% I) S  h* R8 W) D, rSub main()
; P$ I  b: m8 A8 L2 MSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc                                                  '以上交換數(shù)據(jù)
; a' Z; E0 q5 X" o7 hFilename = Part.GetPathName()                                               'Filename為文件名
; j" W5 a, Q3 I, W0 d. WNo = Len(Filename)                                                          'no為工程圖文件名字符串總數(shù)
4 A: ]$ S/ o# M( `, `: U( W5 Q6 IIf No > 0 Then                                                              '當NO大于0時（轉換格式名稱是工程圖名稱，故要先保存工程圖才可轉換，工程圖未保存無名稱，無字符串，不可進行一下步)
Filename = Left(Filename, No - 7) + "." + Right(Filename, 1)                '字串符操作，no-7為去掉工程圖后綴名，"."+ right（filename,1）為增加后綴名最后一個字母作為識別，用于區(qū)別客戶來圖，可不要
' |- {) L- ]5 G% W: E5 ?Part.SaveAs2 Filename & ".dwg", 0, True, False                              '輸出需要轉換的格式文件，已有文件則自動替換，不提示，（有些格式文件在打開狀態(tài)中不可替換，替換不成功也不提示)
Part.SaveAs2 Filename & ".pdf", 0, True, False
End If
End Sub
$ D) p6 N- R- W9 G: j

% w1 Q( ?, i( u. |- U# m
屬性改寫宏:



  W% D2 @6 q1 J9 `% q! Z, }" d/ QSub main()

Dim swApp As SldWorks.SldWorks
; {# F8 N! f) n4 F/ {  ]9 bDim swModel2 As SldWorks.ModelDoc2
1 s: E! ]% c6 P. V4 F* l' IDim SelMgr As SldWorks.SelectionMgr
4 ?* A: D, }7 b- k% W* z2 P" EDim vCustInfoNameArr2 As Variant
/ M5 F& r! _3 p3 t0 c7 X6 l/ e7 ?Dim vCustInfoName2 As Variant
Dim CurCFGname As Variant
' o) Q+ E" a: vDim CurCFGnameCount As Integer
' d# d* G, x9 h" lDim Vnamearr As Variant
. y! s( p5 E* Z7 F! O. i5 [Dim CusPropMgr As CustomPropertyManager
Dim bRet As Boolean
% ]) s# D4 \+ r/ Z  Q: E# a6 u; mDim Vnamearr2 As Variant

7 o+ {9 H: {- E7 \4 W; {$ S: pDim strmat As String
. R0 O; f% |$ o+ F1 L% KDim tempvalue As String
* Y( W! x; a. d' }9 Q; d
4 q/ ^+ _& `7 j9 n; {6 M$ YSet swApp = Application.SldWorks
9 I8 F$ n& ?. B6 v0 |# z4 y! MSet swModel2 = swApp.ActiveDoc
Set SelMgr = swModel2.SelectionManager '
- j/ ?. P- |" y: ?
Dim tg1 As String
2 B7 N0 ]* u: w/ H9 w- X  S* ZDim tg2 As String
Dim tg3 As String
Dim tg4 As String
7 a0 y: ?6 H7 n3 C# v! ZDim tg5 As String
) L8 K8 R# M# C3 {Dim tg6 As String
+ O4 M" L5 d& e( n8 \Dim tg7 As String
# f0 a. l9 B# m8 ?Dim tg8 As String
  o* @- q. S6 S4 F1 u8 BDim tg9 As String
. }$ F; X/ A8 H7 W+ MDim tg10 As String
Dim tg11 As String
8 m% H$ t" R' _2 g  `1 XDim wm As String
* h) j( E  o  U: Q' xDim wm1 As Integer
! v, I% W- F" JDim wm2 As String
Dim wm3 As String
2 H: g/ t: `' {+ t" h$ X* nDim wm4 As String
Dim wm5 As String
Dim wm6 As String
Dim wm7 As Integer
1 o; |2 o! w2 {' ]; a$ R/ _Dim wm8 As String
Dim wm9 As Integer
Dim lz As String
2 ^) }5 m$ z9 Z# _( i: b" _Dim lz1 As Integer
Dim lz2 As String
Dim lz3 As String
' w7 V( F( e5 k- j% n3 u5 zDim lz4 As Integer
- @. ]; G; K" J4 K* e* U* wDim lz5 As Integer
Dim lz6 As String
4 u# y! Y2 g' v6 g4 }Dim lz7 As Integer                                                                     '以上為設定變量
" o% L# ]2 H, m# Y+ O$ C2 y
, v/ m: f# X  Z0 ~, X  r
' ]* a, r2 z" [# [' u4 i7 `swApp.ActiveDoc.ActiveView.FrameState = 1
- T6 ?# e( X" l7 `' P( w) z' K. ZvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
" r5 M1 e' j  O  h* J7 |+ g         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If                                                                               '此段是刪除自定屬性中的所有項和其項值
% E1 k  F) O& U
% d5 J3 D3 W* V, i
+ d  O* A2 X2 S9 BCurCFGname = swModel2.GetConfigurationNames
CurCFGnameCount = swModel2.GetConfigurationCount
! Z: n' Y, v( m* X' {6 cFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = swModel2.Extension.CustomPropertyManager(CurCFGname(i))
5 }5 z9 g" p2 V6 B    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
3 B! }* s& @* C$ C4 M9 D        For Each Vnamearr2 In Vnamearr
! q  R6 r% r3 n! U6 C! h            bRet = swModel2.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
8 B" \9 ?  D( o) n, o% n5 N/ x    End If
    Next                                                                               '此斷是刪除其他配置中的屬性所有項和其項值

2 e! l+ d1 A; f+ R" L! b& k) o- k
! F. J  ^2 O& J4 O+ \9 xwm = swApp.ActiveDoc.GetTitle()                                                         '定義是文件名
; t* u" k. p7 [' d/ g' Mlz = swApp.ActiveDoc.GetPathName()                                                      '定義為文件路徑
2 y6 `; c1 g: k+ ~tg6 = Chr(34) + Trim("SW-Material" + "@") + wm + Chr(34)                                '定義材料屬性
tg7 = Chr(34) + Trim("厚度" + "@") + wm + Chr(34)                                       '定義鈑金厚度屬性
( b$ p8 v! F3 A. qtg8 = Chr(34) + Trim("SW-Mass" + "@") + wm + Chr(34) + "kg"                             '定義質(zhì)量屬性
tg9 = Chr(34) + Trim("SW-SurfaceArea" + "@") + wm + Chr(34) + "㎡"                      '定義表面積屬性
bRet = swModel2.DeleteCustomInfo2("", "圖號")
4 M- i8 m1 m0 D8 D8 UbRet = swModel2.DeleteCustomInfo2("", "Description")
" \  J- }. M* B
% z0 Y" u& }9 y" B9 t
0 W, P( b% ?; h( d, owm1 = InStrRev(wm, " ") - 1                                                              '引號內(nèi)為空格，為圖名分離符號        '從右向左搜索到第一個" "符號為第幾個字串符
& F; [8 w% z( ~5 B# G$ AIf wm1 > 0 Then                                                                          '當mw1大于0量時
    wm2 = Left(wm, wm1)                                                                  'wm2等于從wm的左側開始提取mw1個字符
( h# i' I  p. f0 m3 g    wm3 = Left(LTrim(wm), 3)                                                             'wm等于wm去除左側無效字符的左前三個字符
# Z% h+ v- f2 [9 ?: ?    If wm3 = "GBT" Then                                                                  '當wm3等于"GBT"時
! Y1 t0 x9 m4 {1 e        wm4 = "GB/T" + Mid(wm2, 4)                                                       'wm4等于"GB/T"和wm2的第4個和后面的所有字符              '當零件是國標時添加國標號，文件名中/是非法字符
: g9 S# ~: }- _- i    Else
& a) |. g1 O# R4 g' A$ v% [        wm4 = wm2                                                                         '否則wm4等wm2           '空格前面是圖號
    End If

    wm5 = Mid(wm, wm1 + 2)                                                                'wm5等于wm中的第wm1+2個后面的所有字符
  l/ e( B8 M8 R0 l. z    wm6 = Right(wm, 7)                                                                    'wm6等于wm最后面的7個字符
    If wm6 = ".SLDPRT" Or wm6 = ".SLDASM" Or wm6 = ".sldprt" Or wm6 = ".sldasm" Then      '當wm6等于這4個值時
3 D& \' _- U/ W* e! T        wm7 = Len(wm5) - 7                                                                'wm7等于wm5的所有字符數(shù)-7
    Else
        wm7 = Len(wm5)                                                                    '否則wm7等于wm5的所有字符數(shù)
/ t" e& T( ]/ G3 q! a    End If
0 k+ V1 X( |1 x8 Q( R* h    tg5 = Left(wm5, wm7)                                                                  'tg5等于wm5左側的wm7個字符          ,空格后面是名稱，有后綴名并去掉后綴名，無后綴后（文件未保存時)直接上檔
0 A+ ~' R5 T1 s- a' n- \- J
End If                                                                                                                       '此段為圖名分離定義

4 e: o9 O. \: Y* O. I( ~) @& x
If wm1 > 0 Then                                                                           '當wm1大于0時
( ^7 K" X: `  W" x6 Q9 [$ Utg4 = wm4                                                                                 'tg4等于wm4              '文件名有空格時，圖號為分離出來圖號
Else
: I" ^% M* |9 V: @- r% G" c+ q    wm8 = Right(wm, 7)                                                                    'wm8等于wm最后面的7個字符
    If wm8 = ".SLDPRT" Or wm8 = ".SLDASM" Or wm8 = ".sldprt" Or wm8 = ".sldasm" Then      '當wm8等于這4個值時
1 q1 ?2 B9 l9 f5 g4 t) _        wm9 = Len(wm) - 7                                                                 'wm9等于wm的所有字符數(shù)-7
$ I# _$ |( k. c, G3 n. p    Else
! ?% q( I4 H+ h: v4 D% E! d        wm9 = Len(wm)
    End If                                                                                '否則wm9等于wm所有字符數(shù)-7
tg4 = Left(wm, wm9)                                                                       'tg4等于wm左側的wm9個字符    '文件無空格時，文件名即是圖號，并去掉后綴名,無后綴名（文件未保存時)直接上檔
* e* Z# `7 e6 C: {: FEnd If                                                                                                                        '此段為非圖號名稱命名文件，將文件名加到圖號屬性
'例，fgq01-001 前門板：分離后圖號（fgq-001），名稱（前門板)
'例，fgq01-001 前 門板：分離后圖號（fgq-001 前），名稱（門板)
2 h3 B+ r. d( o' F'例，fgq01-001-前門板：分離后圖號（fgq-001-前門板），名稱為空
/ i5 y1 x- Z2 ?, G'以最后一個空格為準分離

$ Y0 {1 U& H2 Z. N3 ~9 V
lz1 = InStrRev(lz, "--")                                                                 'lz1為lz由后向前搜索到第一個"--"字符在第幾個
' K% v! @' T4 U7 A: NIf lz1 > 0 Then                                                                          '當lz1大于0時
3 {0 Q+ h3 g- o0 p2 n1 A1 x7 o7 jlz2 = Mid(lz, lz1 - 8, 8)                                                                'lz2等于lz的第lz1-8個和其后面8個字符
lz3 = Mid(lz, lz1 + 2)                                                                   'lz3等于lz的第lz2+2個后其后面所有字符
$ X" |( D/ w4 y1 Flz4 = InStrRev(lz2, "\")                                                                 'lz4為lz2由后向前搜索到第一個"\"字符在第幾個
lz5 = InStr(lz3, "\")                                                                    'lz5為lz2由前向后搜索到第一個"\"字符在第幾個
tg1 = Mid(lz2, lz4 + 1)                                                                  'tg1等于lz2的第lz4+1個后面的所有字符
. n; C" X/ M2 R- R'tg1 = Right(lz2, 8 - lz4)                                                               'tg1等于lz2右側的8-lz4個字符(lz2總字符為8個)
( G# _2 u* ^, s' S' W, C5 g' Rtg2 = Left(lz3, lz5 - 1)                                                                 'tg2等于lz3左側的lz5-1個字符

% T  u$ Q$ b) Vlz6 = Mid(lz3, lz5 + 1)                                                                  'lz6等于lz3第lz5+1個后面的所有字符
$ R( W6 o) `0 t  _lz7 = InStr(lz6, "\")                                                                    'lz7為lz6由左向右搜索出第一個"\"字符在第幾個
3 o5 X3 T% ~! ~5 _9 `; K, rIf lz7 > 0 Then                                                                          '當lz7大于0時
$ D0 y" g1 P( [( Ttg3 = Left(lz6, lz7 - 1)                                                                 'tg3等于lz6左側的lz7-1個字符
End If
; r( T% r! K% b: @1 P& Y5 }, kEnd If                                                                                    '此段為文件路徑提取項目號
, h6 ?  c1 @5 m, j5 z- `. P'例，零件文件完整路徑為：E:\工作文檔\B-非標產(chǎn)品\非標--F類\FGQ--定制角架\2020版\前門板.SLDPRT
'由后向前搜索“--”,第一個“--”向前到“\”間為產(chǎn)品編號（FGQ），向后到“\”間為產(chǎn)品名稱（定制角架），向后的第一個“\”和第二個間“\”，為版本號(2020版)。
) ^7 H' \4 ?/ t$ `
/ S. w' u+ j1 [  z/ F" `" \

' j* X8 M- Z- W% |6 A. ]bRet = swModel2.AddCustomInfo3("", "產(chǎn)品編號", swCustomInfoText, tg1)
bRet = swModel2.AddCustomInfo3("", "產(chǎn)品名稱", swCustomInfoText, tg2)
bRet = swModel2.AddCustomInfo3("", "版本號", swCustomInfoText, tg3)
0 j0 U% a1 |. F. O  J3 qbRet = swModel2.AddCustomInfo3("", "圖號", swCustomInfoText, tg4)
bRet = swModel2.AddCustomInfo3("", "Description", swCustomInfoText, tg5)
' B" n$ O7 b5 ObRet = swModel2.AddCustomInfo3("", "數(shù)量", swCustomInfoText, "1")
bRet = swModel2.AddCustomInfo3("", "備注1", swCustomInfoText, " ")
bRet = swModel2.AddCustomInfo3("", "備注2", swCustomInfoText, " ")
- W* U' ~' s$ |* x4 tbRet = swModel2.AddCustomInfo3("", "備注3", swCustomInfoText, " ")
bRet = swModel2.AddCustomInfo3("", "Material", swCustomInfoText, tg6)
bRet = swModel2.AddCustomInfo3("", "SH", swCustomInfoText, tg7)
/ h8 k  q9 K! c" x" }9 _- IbRet = swModel2.AddCustomInfo3("", "重量", swCustomInfoText, tg8)
bRet = swModel2.AddCustomInfo3("", "表面積", swCustomInfoText, tg9)                         '此段為填寫自定義屬性項與其值
* Q* G% `! R5 }! i1 t
Dim thisFeat As SldWorks.Feature                                                         '另外增加一段宏，取讀取切割清單數(shù)據(jù)，并添加到屬性項。
Dim thisSubFeat As SldWorks.Feature
Dim cutFolder As Object
2 R; v& p" S2 P- O, L! BDim BodyCount As Integer
Dim custPropMgr As SldWorks.CustomPropertyManager
Dim propNames As Variant
Dim vName As Variant
$ Y" O, I4 w4 D8 L! ?% CDim propName As String
# Q/ }0 h  {- Q# R" MDim Value As String
Dim resolvedValue As String
Dim bjkcd As Double
Dim bjkkd As Double
: }2 I, {) e' w) v'Sub main()
'Set swApp = Application.SldWorks
4 z/ l$ H. }$ u( C: @5 m' xSet Part = swApp.ActiveDoc
" O  C# U. [  y! U9 aSet thisFeat = Part.FirstFeature
Do While Not thisFeat Is Nothing '遍歷設計樹
If thisFeat.GetTypeName = "SolidBodyFolder" Then
thisFeat.GetSpecificFeature2.UpdateCutList
End If
Set thisSubFeat = thisFeat.GetFirstSubFeature
7 _- L5 \; A& C) h0 xDo While Not thisSubFeat Is Nothing
If thisSubFeat.GetTypeName = "CutListFolder" Then '查找切割清單
1 \" @6 G6 _- cSet cutFolder = thisSubFeat.GetSpecificFeature2
" a, m5 S% P3 a, k" e7 }End If
If Not cutFolder Is Nothing Then
+ B5 C. a  v, X* iBodyCount = cutFolder.GetBodyCount
! a2 ?3 [6 ]( m7 W6 FIf BodyCount > 0 Then
Set custPropMgr = thisSubFeat.CustomPropertyManager
! ^( j& c/ v+ t9 W4 r& mIf Not custPropMgr Is Nothing Then
propNames = custPropMgr.GetNames '獲取切割清單屬性的數(shù)據(jù)全部名稱并放入數(shù)組
7 l8 [* y% c- m% }" [* w6 kIf Not IsEmpty(propNames) Then
For Each vName In propNames
% u; ]6 }; y; B; o8 L. g1 a+ u# L4 W  rpropName = vName
% H! |( w1 r. O* S7 }. }custPropMgr.Get2 propName, Value, resolvedValue '獲取全部屬性名稱 ，數(shù)值和評估的值
If propName = "邊界框長度" Then bjkcd = resolvedValue '判斷是否是自己所需要的數(shù)據(jù)，如果是就獲取
If propName = "邊界框?qū)挾?quot; Then bjkkd = resolvedValue
- ~- J/ A2 k, Y* \6 f8 e1 S, fNext vName
End If
End If
End If
End If
4 G4 |- o& b- p9 I1 vSet thisSubFeat = thisSubFeat.GetNextSubFeature
Loop
; |0 Z4 [; u* l4 S: kSet thisFeat = thisFeat.GetNextFeature
- k! E, [* Z; n9 j2 f) fLoop
'blnretval = Part.DeleteCustomInfo2("", "邊界框長度") '刪除屬性欄上摘要信息的數(shù)據(jù)
'blnretval = Part.DeleteCustomInfo2("", "邊界框?qū)挾?quot;)
blnretval = Part.AddCustomInfo3("", "開料長度", swCustomInfoText, bjkcd) '添加數(shù)據(jù)到摘要信息
blnretval = Part.AddCustomInfo3("", "開料寬度", swCustomInfoText, bjkkd)
1 e% u) _  G+ D, g
End Sub

' \' W$ z- ^6 ~5 x3 g  H

遠祥

挺復雜啊，比較難用吧？？

曉昀

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

柴榮1917

學習一下。

tg-000057

曉昀 發(fā)表于 2021-1-13 17:17
) r! U9 u8 o; L* O- z) r+ Q這個是不是CAD轉pdf的？佩服做軟件二次開發(fā)的人。

cad轉PDF，用cad的PDF打印機就行了，這個是sw轉dwg，dxf，和pdf等格式的。
" R) X7 k4 S, o+ M, X: ]$ U

meltemi

學習一下，