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

arter

各位大侠: " r( R" V/ C* J" J, y$ p0 m% Q     想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 哪位高手能否指点下该如何修改这个宏？非常感谢！ 7 A* s6 X3 X& T$ R8 E( A 3 \* ]3 h% y& v3 @/ y/ i

arter

宏内容如下：
; y1 ]* `8 @1 q* i* F" ^
4 ~% z* _1 O/ ^2 N' ^- `2 A/ E
, c" O" Z' J: P* hDim swApp As Object
, [! r$ s5 Z) p4 d4 _
Dim Part As Object
' r' c% K# T4 n! NDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
& i. E% q4 r; h6 X
0 i* T8 y3 ~6 G8 @) USub main()

+ m/ p  Y1 @0 e) VSet swApp = Application.SldWorks

8 h9 j! d$ W+ c7 C) `0 i. n* DSet Part = swApp.ActiveDoc
6 w( Z( |% \! @/ }+ n& dDim SimulationWORKSObj As Object
1 _, k' P4 Q: S+ I! a0 }! R# i1 ADim CWAddinCallBackObj As Object
8 |, s, T$ U1 Q+ r. @& o+ gSet 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)

4 g/ \5 r8 v6 ~) f- O' Open
& `" m$ c& p6 J, uSet 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
Set myModelView = Part.ActiveView
! L# J+ B$ I$ F8 J4 f/ g" f8 L7 |9 NmyModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
' O2 _" S0 X) w1 W; Z' `myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
+ G) _& Y+ h7 \5 p4 A
# U8 Z  U5 V. A7 y/ D& b4 p' Redraw
4 J# J/ s% r1 f; b7 t( f; hPart.GraphicsRedraw2
Set myModelView = Part.ActiveView
; B8 v9 h' O- N' XmyModelView.FrameState = swWindowState_e.swWindowMaximized
1 ]7 r& u! j# i% i$ B9 ^; M' C7 IStudyManagerObj = Nothing
1 I; u- [  n( f' n" ~ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
+ y1 P8 @; g! S8 W) |$ ZSet SimulationWORKSObj = Nothing
3 l0 j0 G. u6 Q: E& k3 `End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
/ r8 g% W, \8 A! w再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
- Y. O, h/ @+ z+ S" fDim swApp As Object
$ H# L$ f/ p3 g) f- Y& x' ^; @
6 X3 r% Y1 ]3 _' N( DDim Part As Object
Dim boolstatus As Boolean
4 c- x8 q5 ]2 l# X; GDim longstatus As Long, longwarnings As Long

' }& n# ]. j; I3 U) ySub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
! G4 [) n6 U7 _Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
( L/ o( R; t" M- X+ Sboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

( X( E7 \8 M9 a0 L2 R4 S4 u* Z* ]+ U' Open
/ M) [9 |& W" vSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
" B' B* o& a( NDim swDrawing As DrawingDoc
Set swDrawing = Part
+ U3 X! H+ v& e  Z9 R( O; e% ESet Part = swApp.ActiveDoc
( ~) L, H* O, c* b0 |+ `Dim myModelView As Object
& ?; P+ h2 x) b+ h: U! s! u- v! m0 ySet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
* h0 g4 r9 s) W9 p! VmyModelView.FrameTop = 0
' b* ?) k6 @$ D  \Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
. G" ]: Y1 k6 _6 CswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
+ g+ q6 a$ @: p7 N! ~# V
, Y; Y7 v# B$ c0 N6 y! r. D7 n% u. q- c' Redraw
Part.GraphicsRedraw2
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
6 S/ f/ F& t. f* p4 K& J9 `% @' kEnd Sub

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
3 H1 T% U8 s% qDim swApp As Object
& v, a. ]4 D% h+ Y- _Dim Part As Object
Dim boolstatus As Boolean
- a& B3 G- o- q5 kDim longstatus As Long, longwarnings As Long
; B& b  R% d. J1 ?# B) A! jDim Filename As String
Dim No As Integer
Dim Title As String


Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
2 O0 L, d5 W5 ?; E  q. o7 Vboolstatus = 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)
0 b) V5 T$ W- W2 s' J/ p; e3 y. `Filename = Part.GetPathName()
No = Len(Filename)
! @) l: T( u7 }+ pFilename = Left(Filename, No - 7)
$ [) t# {$ \2 X0 d. K, o& _
- E: g) f: q/ gSet Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
  l9 K( q! R: Q4 E' ]6 SSet Part = swApp.ActiveDoc
2 }- X2 b# w* J% lDim myModelView As Object
7 f. v* |. j) S" U1 ^Set myModelView = Part.ActiveView
- Q& r' {0 W4 j+ dmyModelView.FrameLeft = 0
+ Y1 H; y$ w; _3 l" C2 v- v9 dmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
, l1 g) }7 x6 t( j4 rmyModelView.FrameState = swWindowState_e.swWindowMaximized
$ C! D% |4 I; E  m. r- ~8 [) pSet Part = swApp.ActiveDoc
+ a: \; K: g* y) f; lSet myModelView = Part.ActiveView
. ~6 s+ x- u+ \myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub