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

arter

各位大侠:   d: m$ l& e9 r9 H( X     想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 $ A1 @/ }8 P. }* ?2 W4 {哪位高手能否指点下该如何修改这个宏？非常感谢！ 6 h( S  W/ R* b

arter

宏内容如下：
* T; I* x: K' N  C. l6 c

. e6 o8 [( b, f9 D/ sDim swApp As Object
6 k+ v5 P5 Z, q& U. ]/ s: J
Dim Part As Object
: E3 S. z! r$ P- F& D( @% [. |Dim boolstatus As Boolean
" [+ D0 }3 e: oDim longstatus As Long, longwarnings As Long
- K9 p2 F3 E8 f$ @1 J
5 H1 J0 R( X, b* X3 X* jSub main()

Set swApp = Application.SldWorks
# ^  w, y/ o+ W3 Z8 |6 p
& n+ k5 J5 i3 Q1 ASet Part = swApp.ActiveDoc
Dim SimulationWORKSObj As Object
4 R$ m" i1 s' }- {8 iDim CWAddinCallBackObj As Object
0 D5 A$ ?$ P8 }' i& I, s; FSet CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
2 ~' J* Y+ Z6 N+ n1 u; T$ KSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
( ?3 h% _8 v* I( h+ nboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
5 R3 O- t% V( e4 w: t4 _; Q
& q- g* V  I1 u0 b' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
' y$ _2 H. ~: M, KSet Part = swApp.ActiveDoc
Dim myModelView As Object
. A8 @/ n; F$ {5 CSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
* m% h1 ], t6 c  G' {( `2 ^  _+ |myModelView.FrameTop = 0
9 D' F8 U3 L5 C9 @+ O$ SSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
% X+ r  h" z) O. P0 uswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

' Redraw
5 I& B! l4 T. ], o9 CPart.GraphicsRedraw2
  k- p1 F- T! Z2 i2 \1 e% ^  vSet myModelView = Part.ActiveView
& h7 Q9 i. q8 C5 s" G+ }myModelView.FrameState = swWindowState_e.swWindowMaximized
- [% y( e% ^' V$ t5 \1 X, s) {StudyManagerObj = Nothing
ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
% g! E/ D, x% H' {# D8 s. lEnd Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
' J4 C) {+ T3 V0 b8 r2 z再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object

Dim Part As Object
0 e" Z# x& m6 c8 G4 bDim boolstatus As Boolean
, l) ?: A' z" r" o* [. \( x/ `Dim longstatus As Long, longwarnings As Long
1 r8 j2 x0 F8 K: ^, D
# t6 n7 r$ X! @# N2 VSub main()

4 ^8 B" K+ Z: c* x7 iSet swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
' w0 T4 L* h* C3 ^- h/ ^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)
+ d* f/ J  F( S& H3 f: VDim swDrawing As DrawingDoc
Set swDrawing = Part
Set Part = swApp.ActiveDoc
7 E( g$ L* n8 I# Q9 P& `  ?Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
; r( z% Y0 F" K, @Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
5 U/ }- E2 B+ O! T+ }' ^! G3 TSet Part = swApp.ActiveDoc
) J" x- o4 w8 y& f3 ]5 S
' Redraw
8 U* _' C' T0 c5 d7 S, PPart.GraphicsRedraw2
5 T4 s% P# ^4 L: B! b' M7 ?0 v- ^Set myModelView = Part.ActiveView
7 R3 p7 ^/ A7 t( h! G# wmyModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
1 c) ^, L5 N) n. O" P  BSet COSMOSWORKSObj = Nothing
: I$ Y1 ^" ~) @5 bEnd Sub
" [$ ?' ?! j  w

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
7 X7 M% F8 f  WDim swApp As Object
Dim Part As Object
5 p: a1 I) x" ]  r+ j2 V% uDim boolstatus As Boolean
1 A( |7 y3 b; V) KDim longstatus As Long, longwarnings As Long
5 ~* A5 L2 [  S- x) n2 w  cDim Filename As String
Dim No As Integer
$ s4 s6 j* k% h' cDim Title As String

) P$ c. t; @3 C
Sub main()
+ R, x7 x  K, K. m, w  o3 ]9 |
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
7 F8 u. ~6 D  q6 }( _, hboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
. h2 m. [8 i! W) X$ bSet Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Filename = Part.GetPathName()
6 W3 y" A" j0 s. y, UNo = Len(Filename)
Filename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Dim myModelView As Object
2 `* i( N) y9 l2 RSet myModelView = Part.ActiveView
) T" z! ^" Y4 {& fmyModelView.FrameLeft = 0
1 p( E2 O- z/ N( S! c! G, P  HmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
- G! A( x& h6 k! cmyModelView.FrameState = swWindowState_e.swWindowMaximized
/ u' M1 z$ _8 A4 e# b% r. ySet Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
& M! C" W% j, kEnd Sub
2 u! T6 `1 [$ `* d