快速打开零部件工程图的宏”的问题

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； ) e* a. r$ q" g" F3 s2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 , K" x$ |6 b* T8 P; S# @0 i0 ~; K哪位高手能否指点下该如何修改这个宏？非常感谢！ : H' M. Y3 i7 V8 C( w+ J! e- K& ~

arter

宏内容如下：
/ J! G3 ?1 d+ {) m0 r
6 |% F: c. {( u' d% s2 F$ U; }4 e
) U% Y* e( W; D( X8 _! dDim swApp As Object

0 M+ b: B. H" y7 |Dim Part As Object
3 J& Z; H1 k8 UDim boolstatus As Boolean
1 d: D0 K' Y8 P) ^- X3 L% }Dim longstatus As Long, longwarnings As Long

Sub main()
, h7 x2 C" T% \  @* j7 R3 f2 e- S: \
+ }  z7 q  w+ P4 m; VSet swApp = Application.SldWorks

6 S# ~* H2 _( p) z% F- g4 jSet Part = swApp.ActiveDoc
2 _3 C) v" @3 t) ^4 @* T$ o8 nDim SimulationWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
8 f$ v$ E: g7 _& FSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
boolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
: Y7 x: Z8 |  Z/ [' ZDim swDrawing As DrawingDoc
- P2 I' d0 g! Q5 \! @Set swDrawing = Part
) d! T8 y; T* \1 i( uSet Part = swApp.ActiveDoc
% F# N% n' K5 b6 D% L3 b1 D+ Y& WDim myModelView As Object
& S2 j' A3 q/ qSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
8 l- u- [6 _" C* M# l% r* DmyModelView.FrameState = swWindowState_e.swWindowMaximized
/ }1 ~* E' M6 ?/ M- |3 `swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

( E1 j! O" G2 t$ K/ c* W, [+ t# u# Y& N' Redraw
6 \3 x. c* \/ Q6 VPart.GraphicsRedraw2
Set myModelView = Part.ActiveView
, n/ S9 W/ Z" Q7 ^+ wmyModelView.FrameState = swWindowState_e.swWindowMaximized
8 v% B; Y0 M# xStudyManagerObj = Nothing
8 J1 x; Y" e& E( }$ U( V$ d7 OActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object
. v- [* E' U# G- y& C3 M
$ [# J8 t. q/ \. E; g4 G/ sDim Part As Object
2 F! x! q/ R7 f, y0 h* \Dim boolstatus As Boolean
+ Q( g# o! \' o. [. BDim longstatus As Long, longwarnings As Long
  K( D' G# |7 ~3 L+ _1 H0 t
Sub main()
% @+ F3 }7 X1 \
Set swApp = Application.SldWorks
0 |6 ~/ y9 ]! u% c8 k
Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
7 T  J' t& k8 q" UDim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
3 q2 ?" Q& @9 h" k: g3 ySet COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
( r/ {+ g. v- `& I3 r4 Vboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

' Open
" Y/ D3 g3 [* s, zSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
  B, {" F! Z* _. Y! z- [9 USet Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
! `, K, p  s6 }# VmyModelView.FrameLeft = 0
- s7 g( |0 F6 Y; Y+ w. N2 Y; CmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
0 e5 H, [  {+ v2 Q: Z/ t) V+ XSet Part = swApp.ActiveDoc
7 _- Z1 C$ s2 x& i9 ?  l
( Y& D5 B7 ?0 ~7 [, b' n+ R' Redraw
Part.GraphicsRedraw2
5 i. F! V1 u' o; pSet myModelView = Part.ActiveView
7 y! N/ u& b8 \$ p2 pmyModelView.FrameState = swWindowState_e.swWindowMaximized
' j" d) F# K, @& y6 b  \Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
End Sub
1 m  P# }6 z% Z; e. f. f

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Filename As String
Dim No As Integer
* ^" q8 p! J' @, l% VDim Title As String

: P- X  o6 s7 Z3 H& d( m
Sub main()
8 m, _! N! P2 [; m2 q9 g" Q
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
6 v) ?! B" I6 ^- {' Aboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Set Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
# D8 y; F8 G9 LFilename = Part.GetPathName()
No = Len(Filename)
- M5 y! K+ t/ v6 {; _& K7 Z: UFilename = Left(Filename, No - 7)
3 K6 r8 o: ^% d: x; P+ v: k
Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
$ ~6 [, m1 j, F' j8 i% |Set Part = swApp.ActiveDoc
* o8 _' k9 A" C" g; V6 U1 FDim myModelView As Object
- b5 X; f; q# OSet myModelView = Part.ActiveView
+ y. H3 ^- m- M. g* I3 xmyModelView.FrameLeft = 0
6 Y6 D& a3 Q- y8 w3 T0 q: x( K5 gmyModelView.FrameTop = 0
9 @" ~& D% t1 |: P0 ASet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
# p: ]/ ]* t2 c5 rEnd Sub