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

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 2 ~5 ?# W, X: w! a$ Q8 ^) h 哪位高手能否指点下该如何修改这个宏？非常感谢！

- o' C8 b4 n* E( Y* W2 [

arter

宏内容如下：

3 L+ b0 J% \: S) i7 O" f
Dim swApp As Object
. g6 E) H6 M( }* d/ R% }8 o, Q( R
Dim Part As Object
: p, s7 z, O: d/ ~" \  Q% {Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
% f) U- [: t0 @0 n7 }
Sub main()
6 m+ d6 k9 h( P/ B
Set swApp = Application.SldWorks

; A: c7 _3 @7 l- ?Set Part = swApp.ActiveDoc
Dim SimulationWORKSObj As Object
Dim CWAddinCallBackObj As Object
4 `% E2 ^- h  q9 k0 a1 oSet CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
& [+ C3 u! t. r# f+ v/ J6 eSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
$ S! [6 c5 @/ x! e9 Z7 iboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
& l6 M; L" `+ R9 H( a: e9 K. Q  f! Y/ `
' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
9 j- u) i. A* k& b5 Z1 ZSet Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
9 m* q' L0 Y0 B( k9 `1 v* {myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
& G0 R* ]+ P6 m& BSet Part = swApp.ActiveDoc

' Redraw
Part.GraphicsRedraw2
" o! `. k) Y; @/ G- O! @4 v; E: hSet myModelView = Part.ActiveView
  W2 J8 Y: e2 q+ R* AmyModelView.FrameState = swWindowState_e.swWindowMaximized
9 P. D. p2 Y" q5 B) SStudyManagerObj = Nothing
ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
1 ^. F" M. E, N4 ]2 T) {, nSet SimulationWORKSObj = Nothing
End Sub

arter

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

Dim Part As Object
/ o4 q; x1 X+ c3 u: X6 ZDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

* F4 U+ @; ]3 M) ?; W0 ?1 \0 e8 T: @Sub main()

Set swApp = Application.SldWorks
: {5 W( z; D2 t* u: D' x; Z) H6 m
8 Y: c- z. }1 K! F) V% E0 USet Part = swApp.ActiveDoc
) @1 f+ ^& a/ L& ^; f3 sDim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
" V. `+ a5 }9 x9 j6 Lboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

' Open
- F; L  B" ^) }, ~Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
3 V, s. q9 o0 v2 x5 LDim swDrawing As DrawingDoc
! F& ^0 n0 \3 VSet swDrawing = Part
Set Part = swApp.ActiveDoc
4 Z6 D' z  n1 w3 L& RDim myModelView As Object
Set myModelView = Part.ActiveView
. q  P) Q! V: {myModelView.FrameLeft = 0
myModelView.FrameTop = 0
- @* {2 V) A/ ~3 T/ r5 Q9 ^( jSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
& }, Q* M5 ^2 M5 i6 \5 g6 t7 YSet Part = swApp.ActiveDoc
2 M! O# y3 x8 S( f2 `
' Redraw
Part.GraphicsRedraw2
! q9 M3 ]5 A# W' m3 O5 }* SSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
5 e- w$ c6 B  _: T/ @Set COSMOSWORKSObj = Nothing
End Sub
/ y% Z- G5 L+ t% t( b7 z

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
+ g3 h1 D% X& P* a* |Dim Part As Object
# ]1 h6 q* ?  L( x" x/ r1 PDim boolstatus As Boolean
( f/ G8 @; g* C. lDim longstatus As Long, longwarnings As Long
Dim Filename As String
Dim No As Integer
% \! |7 p( Q$ Y# x& dDim Title As String
5 ~, y" U3 F  b6 w

Sub main()
& [0 }4 x& x: n* ]8 V
Set swApp = Application.SldWorks
5 m$ o" o$ n9 h. o" H! t! tSet Part = swApp.ActiveDoc
7 E( ~" f  S% Z8 C1 }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)
7 K% Q4 y* r. x, Y: ZFilename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)

, l- L' r7 d' ]7 V2 `% D- {- ^1 aSet Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
* S5 E+ {9 F" A1 qSet Part = swApp.ActiveDoc
$ t+ s1 b' l/ T2 S1 GDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
( z! u# I+ r4 C2 W9 t! kmyModelView.FrameTop = 0
$ e, y9 p" p! C' Y9 f3 ASet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
, o& a+ W; \  F1 ^$ XSet Part = swApp.ActiveDoc
* U: b$ |, @& s, q1 w) U9 k8 H7 D3 ]Set myModelView = Part.ActiveView
: ^% x  d& O% x2 rmyModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub
3 X5 `+ D5 q$ b& O0 S5 L7 \