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

arter

各位大侠: , x% g" b9 Q, j6 `8 T     想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 3 ?5 h5 U2 a, E5 K2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 5 K! l4 {1 `- v1 e; c( n哪位高手能否指点下该如何修改这个宏？非常感谢！ ( ^- g; {/ p7 M5 T; U , K9 r3 G6 p+ Z3 r+ T

4 b, c; D& i8 ~0 S

arter

宏内容如下：
9 F1 Q2 H+ v( Y$ ?; ?" ]

/ Q! u1 ~3 \+ w4 K) }* P- |Dim swApp As Object
" a3 U6 ?9 s* E1 Z8 @/ B, x* X
Dim Part As Object
Dim boolstatus As Boolean
8 h2 P8 l' h0 e7 Q$ I* DDim longstatus As Long, longwarnings As Long

Sub main()
; s6 F/ M$ B# _" I( ^( F8 T
5 {1 l/ G* d9 ?7 Q7 kSet swApp = Application.SldWorks
( c( |8 y. A0 A; A' ~5 P
; e3 i; O3 M$ S1 g  r2 gSet Part = swApp.ActiveDoc
Dim 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)

' Open
4 i: E; T7 {2 B  ?( @Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
8 L1 P4 O$ @* T! u8 F) J/ U  p( TSet swDrawing = Part
8 `) e$ A" ?8 C" C' WSet Part = swApp.ActiveDoc
Dim myModelView As Object
# q% s* p/ ?% A8 c) O, w9 ZSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
; Y' r* ^  H& _0 v* l6 O3 \& qmyModelView.FrameTop = 0
9 u! D, s( l# t: V& WSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
. X7 r8 W/ i2 R% RswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
5 e% g- X' ^$ Y7 s  a9 L4 l
, t+ g  q9 y6 l& Y, l0 _1 w' Redraw
% {4 I3 {# v/ G! dPart.GraphicsRedraw2
: P2 r+ ]9 |  H% b/ l- wSet myModelView = Part.ActiveView
* D& p6 a) @7 UmyModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
5 B0 M' o5 ]4 M+ A; ]: l( k4 YActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
6 J. I2 T: Q0 r+ ?4 HSet SimulationWORKSObj = Nothing
! J$ ~4 q: S/ t" aEnd Sub

arter

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

Dim Part As Object
0 \, m5 {- F8 e7 x6 h0 iDim boolstatus As Boolean
# K; f* X# r3 C# ~% O' YDim longstatus As Long, longwarnings As Long
8 o9 @2 Y9 V3 |. z7 E& O2 D
Sub main()

Set swApp = Application.SldWorks
6 |- E2 I1 V3 v: b1 V
+ h" V8 i1 H. K5 X* C0 sSet Part = swApp.ActiveDoc
: w  @& l8 i% X$ T0 B$ C0 yDim COSMOSWORKSObj As Object
7 h# E7 w' ]8 r1 \, n2 L  ~' }# jDim CWAddinCallBackObj As Object
" G% i# v" C' R2 K9 h5 r9 C3 ISet CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
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)
% ]8 l5 I0 l, G, X. pDim swDrawing As DrawingDoc
Set swDrawing = Part
Set Part = swApp.ActiveDoc
! T, R8 V4 [& TDim myModelView As Object
+ U! k' K% ?3 L, vSet myModelView = Part.ActiveView
( c6 l, }" }: U3 G7 ImyModelView.FrameLeft = 0
myModelView.FrameTop = 0
. R# {. X+ J  s6 z( C0 s3 mSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
. e& o0 \. N+ b3 W: a  {
' Redraw
Part.GraphicsRedraw2
9 B# Z6 o' K* k5 ?- w2 RSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
+ I; f" O. T9 PSet CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
End Sub
$ T3 x5 k; v5 c  }# [. W

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
8 W6 o% e9 \: r) W) yDim Part As Object
: ]" g3 M5 `& e9 c8 M: eDim boolstatus As Boolean
, I9 r' D) ^+ u* EDim longstatus As Long, longwarnings As Long
! ^! K+ y" A- KDim Filename As String
' ]! P' ?( [9 Y$ |) [  G. CDim No As Integer
Dim Title As String

/ `' y& \3 a! S2 }" s+ \+ b( q& ~" m0 V
- N  B" K  T) HSub main()
7 C7 u4 a, L, v5 d6 T, E
9 k8 l" D2 T4 ~Set swApp = Application.SldWorks
0 X  c( R6 g: j) sSet 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)
. A6 N3 T  t' m1 c. z" G1 x# mFilename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
% d8 g# s$ L6 F' b4 NSet Part = swApp.ActiveDoc
Dim myModelView As Object
( b  P7 V& e+ I, kSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
3 j; Y- Q. x/ W% vmyModelView.FrameTop = 0
( Z" z2 n+ I+ U# p( r& ySet myModelView = Part.ActiveView
5 W4 Z3 `  k/ o' T6 q* Y% mmyModelView.FrameState = swWindowState_e.swWindowMaximized
6 ^: m$ \4 A+ B( G4 ~5 n6 sSet Part = swApp.ActiveDoc
7 l- K/ n2 q' Q2 q* qSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub