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

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； " l% ^+ I4 C& V; b2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 6 d! A' ^" b: Z2 f1 ~ * N: k0 X/ c$ u哪位高手能否指点下该如何修改这个宏？非常感谢！   \: r0 j, m' b1 f4 T# q" l6 e

arter

宏内容如下：

! E  x, f8 w- G! X( s% @
0 p; i$ k' d2 z) v+ i" {& y, uDim swApp As Object
) b& R/ c3 L6 }2 n5 w
Dim Part As Object
4 e3 Y8 }$ h& E. }Dim boolstatus As Boolean
2 t$ |% a# {; GDim longstatus As Long, longwarnings As Long
& }) P& K; [: n) b4 o6 i
Sub main()
2 M6 u, f* N3 V! ?; D8 b
7 L4 w3 y2 u' m$ fSet swApp = Application.SldWorks
' ?% |4 Y  S; T( C; }
  o* S& i0 {" _4 d2 v7 D( w3 fSet Part = swApp.ActiveDoc
/ v  }( C. P/ ^& p# O* rDim SimulationWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
Set SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
boolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
! l) u2 r0 \- L7 C- p
' Open
* q: j1 F5 ?$ Y  W1 q& TSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
+ |& {1 _+ k% O( r2 F+ ^' z7 j9 e5 ZSet swDrawing = Part
Set Part = swApp.ActiveDoc
$ f4 [$ v( p4 T" E% k9 d* HDim myModelView As Object
8 c+ F- }3 c! T6 lSet myModelView = Part.ActiveView
' B$ T1 ]9 b+ s% l6 A: c! f% TmyModelView.FrameLeft = 0
9 z& s, r5 H9 O( \; B% M1 A: }' OmyModelView.FrameTop = 0
8 J3 R3 y! v# J  y1 L* y" |+ L) o) ISet myModelView = Part.ActiveView
7 E8 W4 z, o( y$ G4 O  N9 d9 GmyModelView.FrameState = swWindowState_e.swWindowMaximized
5 }4 e9 Z9 e/ F% RswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
9 h: c0 J: L& y$ g/ j# |Set Part = swApp.ActiveDoc
9 X! p8 ~5 U: P( L& S+ z
' Redraw
! X; o8 T* _! |; IPart.GraphicsRedraw2
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
: ^7 R0 Q! N5 m$ a; x$ k8 S0 QSet SimulationWORKSObj = Nothing
End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
' D. ^; \" h1 b# E5 o再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object

Dim Part As Object
8 w, p* k: |8 `8 i5 _Dim boolstatus As Boolean
6 I' ^6 W$ C5 n" r# _Dim longstatus As Long, longwarnings As Long

' n9 W$ k* Z: e# o" O* S6 [9 bSub main()
' P' ^  z* N; P: |* w) A  d
& v" |) U3 v7 T' p2 L3 s# lSet swApp = Application.SldWorks

3 w2 ?, @1 k* a' W5 USet Part = swApp.ActiveDoc
9 ?# z+ v, t* bDim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
: l1 l+ M5 P7 O3 g& N1 d0 G7 a- A" wSet CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
' r( K  ]0 Y/ O& M1 ^; R5 \+ ySet COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
9 C* l( e/ L/ ^" I) G' Tboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
' T8 i1 W) u6 [8 ?+ w' o4 g& d
4 t; a4 F2 Z9 K" v) X' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
/ u; F7 m* X6 S' WDim swDrawing As DrawingDoc
& ^. X2 }* T, N9 D% ?3 Q" g6 ySet swDrawing = Part
" y$ u% v' e2 k" g4 w4 o8 u  g8 ISet Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
# ?4 I) E: S, O0 V; k5 W4 lmyModelView.FrameLeft = 0
myModelView.FrameTop = 0
5 O( j) p' r, e( xSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

& z7 Q5 F& B/ [6 a' Redraw
Part.GraphicsRedraw2
2 w5 x2 J1 Q, F$ G0 w: vSet myModelView = Part.ActiveView
1 x# z* L4 d  d, {0 C/ G1 ?myModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
4 J. R2 w6 o* U6 A9 \* ?, u6 \/ wEnd Sub

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
0 E% u6 y* c  v" @) ^! h1 NDim swApp As Object
- w6 l4 S0 q4 H/ n1 Y' T, F* g& eDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Filename As String
0 a* i3 V# n0 C. x1 v; yDim No As Integer
& g& k. O: A1 Q) T! v: ]; a4 E* rDim Title As String


Sub main()
. x: K" J% [) ]# U" g$ e
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = 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)
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
4 E  q1 v" {( zSet Part = swApp.ActiveDoc
5 u% ^" `+ i( IDim myModelView As Object
! O: i2 H3 [2 K1 x' a. G2 jSet myModelView = Part.ActiveView
, ^, _6 x6 E8 n& NmyModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
  t( r/ b' i; E! ]  g/ N) pSet Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub