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

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 ; c4 r: K9 p2 O5 g. X" o4 D 6 U: Q" W+ e/ ]9 Q9 m# `) s哪位高手能否指点下该如何修改这个宏？非常感谢！ ; k1 B8 v: |) Y4 f6 M

arter

宏内容如下：


1 {9 [. @. T' B% V: n4 J# N/ \7 |Dim swApp As Object

3 v3 V# M2 [: L) \* ODim Part As Object
Dim boolstatus As Boolean
( O! T( ^; x! bDim longstatus As Long, longwarnings As Long
' s1 f! i$ y' M& G2 C
2 A. H5 k. `7 n9 h  G  |Sub main()
% ^. N4 m2 b  w9 W) r& u2 y' k
Set swApp = Application.SldWorks
6 H8 [; u9 b2 A9 y( R
; O* g* d* b5 G8 p0 F. e  Y- rSet Part = swApp.ActiveDoc
. h5 ?* I  _# L4 C' I) I2 ^Dim SimulationWORKSObj As Object
; P( r0 U3 y" D1 a( d+ w8 }# ], wDim CWAddinCallBackObj As Object
- {% a* D3 T$ M0 P1 ySet CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
1 [# Z5 P  y' v8 V1 e* e( fSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
# k3 l: ]0 i8 iboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

' Open
# a, D) N1 b# n3 ?8 n7 V4 |Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
. u& c& N. z  d; nSet Part = swApp.ActiveDoc
Dim myModelView As Object
5 v: d$ O3 ~1 G4 X0 ^% X: QSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
. @/ T/ [. r, {7 Y5 mmyModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
( ]0 J, ^+ b9 _
& V& m+ e4 P8 ?' Redraw
Part.GraphicsRedraw2
Set myModelView = Part.ActiveView
% g/ V' G) a$ MmyModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
0 c4 }: U7 I- j# a# U' U5 R" bSet CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
8 f2 o* X' I" a2 @7 G2 V再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
  r3 c, w8 @3 m2 aDim swApp As Object
) F0 H( Y- U2 Y
( s5 B6 U1 `% \# ]; T# i6 p8 ADim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

8 N! D" D( \0 p3 l, K/ `Sub main()

: b3 T% l% t0 M& t' lSet swApp = Application.SldWorks

* V  a) f8 p3 T/ V8 bSet Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
" t: W7 g9 o, R1 A) X! ?Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
$ I6 A  N9 P( \Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
( A; l, [4 ?( P+ y0 fboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
8 q) F7 L5 {4 m" V# s0 {+ s! J
' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
Set Part = swApp.ActiveDoc
Dim myModelView As Object
# a! ~0 ~, L; f/ g3 mSet myModelView = Part.ActiveView
! x% J% s% x# D! K, Y, MmyModelView.FrameLeft = 0
$ ~# {: x: ^+ J4 d. E/ u/ _" wmyModelView.FrameTop = 0
0 `. [& {& D& \% H2 uSet myModelView = Part.ActiveView
" I1 E$ L* P1 \, ?0 R: _myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

& Z2 M; U- Z3 `9 U' Redraw
Part.GraphicsRedraw2
' u$ u/ y5 p# o, `& H4 E$ |Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
5 E+ z- A; R$ rSet CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
# u# ~, s; A3 w8 b" uEnd Sub
, o. h4 W- {/ R7 h' {. ]

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
' Z/ d7 [6 _& o! K" D, V. }Dim Part As Object
Dim boolstatus As Boolean
( ~. S+ V1 |# {* B( h- ADim longstatus As Long, longwarnings As Long
Dim Filename As String
Dim No As Integer
Dim Title As String

9 ?0 J5 u4 @# V' {' T% u
" p" F; l$ f  ~Sub main()

" ?+ k, R/ j$ P7 t  C3 `Set swApp = Application.SldWorks
' G& H, [' G% L. \7 F$ ySet Part = swApp.ActiveDoc
7 V% I+ W# u" |6 Y% mboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
' S& U7 Q9 d7 I# Y2 F/ k& a# Q1 c% bSet Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
$ K9 n4 F" c6 iFilename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
- v0 a& q) l2 J  \3 I: q# J8 X
Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
. k2 ]0 f  K( h/ X9 N7 F2 Z" XSet Part = swApp.ActiveDoc
( d; n# z7 i# h2 h9 ]' @Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
' R. k7 C$ p9 H6 h" N7 QmyModelView.FrameTop = 0
1 V0 n5 i! [( iSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
2 i5 Q3 V: M: W+ J, w" c1 Q$ XSet Part = swApp.ActiveDoc
! J( f: o, w5 M% H9 iSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub
8 U- G$ c' C" y5 Z