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

arter

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

2 r* P, M4 o) B+ z0 D

arter

宏内容如下：
) `  E* I! W9 g* c* X, S

6 C5 S5 g: z- X  n+ s; [+ SDim swApp As Object

Dim Part As Object
+ u2 T$ G" }* {' F: F1 {# M* W" |Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim SimulationWORKSObj As Object
# R6 f" A/ D' a  A- X+ {" JDim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
! n8 I$ H8 \! f/ ySet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
boolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
. e, b! R' F, ^- k1 S) Q) T
' Open
8 G; J4 T! u( B3 A" x9 }Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
" ~! k& ^4 O0 ?! r: K. ?  K; g5 R( }Dim swDrawing As DrawingDoc
Set swDrawing = Part
Set Part = swApp.ActiveDoc
" }8 ^; z" t' z# ?9 q; a, F! L& ?Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
, r% P: n. N/ |$ XmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
8 D' ]8 I% A! R9 |1 {! T" v
' Redraw
' M3 d* l1 o) n( K& \Part.GraphicsRedraw2
Set myModelView = Part.ActiveView
7 C" r; g5 \7 P! s4 _+ @5 `myModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
6 G0 n' ]4 E% ]+ ~Set CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
; D0 \9 r3 a' E6 A0 t+ gEnd Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object
3 E* [6 n$ F5 ^+ z5 U
Dim Part As Object
Dim boolstatus As Boolean
' d, t% ~/ n8 X, t! D! tDim longstatus As Long, longwarnings As Long
8 ?* n0 u* v5 j' N$ w
Sub main()
8 G1 G3 C# [, N/ a. x
9 O& G+ ]6 j! U) v& P# l: B, f7 ?Set swApp = Application.SldWorks

( o8 I* U) D. Y- |4 L  s2 B/ ZSet Part = swApp.ActiveDoc
$ V  p1 C- {* GDim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
8 \+ C* e2 J3 E, s6 p. fboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
4 b4 d. t' r: j) a! ^' [7 W
8 V& U" K1 T+ Q, m3 p' Open
9 }! C5 u& x2 R3 `& U- v/ uSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
& K4 h1 G2 g8 D, T9 aDim swDrawing As DrawingDoc
Set swDrawing = Part
" }* |% @% A/ D' E$ X* sSet Part = swApp.ActiveDoc
0 K- I$ M5 O4 C8 s" V9 e6 E5 M1 B1 ~9 EDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
( }9 [# @0 m  ~1 ImyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
$ ^9 ^' j6 s5 W3 D" F( k9 w, VmyModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
& c# b) c) P: p3 _/ \6 P
' Redraw
Part.GraphicsRedraw2
) z. i3 g/ M" r/ xSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
5 r, F: R$ {( Q4 D7 \) m$ `Set CWAddinCallBackObj = Nothing
/ L# F5 n4 J" g: J- xSet COSMOSWORKSObj = Nothing
End Sub
. {! d8 g" G$ g1 e9 U- _

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
9 B6 X; W' W5 w/ w$ pDim longstatus As Long, longwarnings As Long
. g/ J, w- K) G9 \1 lDim Filename As String
Dim No As Integer
9 }. I8 H, N" IDim Title As String
% [" J5 q( C) o1 \6 A
1 i( B3 O/ e7 ~3 Z* D: d' s, v
Sub main()
# o5 X. W- S& y2 x0 b
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
6 u$ g3 N8 J) _% {Set Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
7 G; a3 W1 ^) a" |$ iFilename = Part.GetPathName()
* J& c$ |* {4 c! Z/ J& T& g, VNo = Len(Filename)
; @" A$ m7 \3 z. C0 j3 g& PFilename = Left(Filename, No - 7)
" `- f4 L3 a! g* }% I- W( K
Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
! F: N3 }3 h% X8 E7 T# ~5 ~Set Part = swApp.ActiveDoc
Dim myModelView As Object
7 d3 q0 G+ c: J2 _+ `Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
% a: [2 Q+ T( O' l- _+ e: A% J- WmyModelView.FrameTop = 0
" s8 o+ P8 z  N7 s6 t4 rSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
* F) A3 f1 \! A1 M0 {- `Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
9 r& p3 r4 L+ P! ?+ V9 YEnd Sub