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

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 * Z& D$ {, F' t( r! ~8 _$ u $ S) a  S" V3 Y' [; C( o8 Z哪位高手能否指点下该如何修改这个宏？非常感谢！ 1 f# j; D( g5 I8 i4 O$ `

1 J! H/ [, X7 ~2 X  R" v( b. ], j) r  R

arter

宏内容如下：

, ^$ I7 t4 `$ U
Dim swApp As Object
1 I) p, u3 I) A6 `1 D# P1 W
9 ?1 A3 e! n, B" ?Dim Part As Object
Dim boolstatus As Boolean
7 U, x  J- i1 R- o5 ]9 I/ I# gDim longstatus As Long, longwarnings As Long
5 k' ~7 B# u& N& M8 d/ I
Sub main()

$ G9 }; n" }9 S$ O$ ?; M# ESet swApp = Application.SldWorks
# p. w* J+ w2 h% p5 A. o( a3 ]
Set Part = swApp.ActiveDoc
1 ?6 _$ i7 Y$ _: w* ]5 }4 oDim SimulationWORKSObj As Object
& v& z: _) p  y$ n, |5 K9 pDim CWAddinCallBackObj As Object
/ ?$ T% U$ m  n/ U* ]Set CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
$ f6 j; u& l7 o# g' BSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
9 P! X9 k* U6 E- cboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
, w& T8 K/ V* Z4 X
' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
5 n1 \; |' ~9 }) BSet swDrawing = Part
# f: F! h8 f0 n, E7 q% v5 z5 {Set Part = swApp.ActiveDoc
! O1 E6 X: A+ x3 pDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

' Redraw
8 K% H' _0 B. e- N' H/ a" ?Part.GraphicsRedraw2
3 d3 {% W# J) v( C5 c! S+ @Set myModelView = Part.ActiveView
- M* K# [8 T% e! h# xmyModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
) t9 ], V  C! |& K, g+ GSet SimulationWORKSObj = Nothing
End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
9 Q. S& a0 w: [  O  z: r0 m9 O% _- l+ _再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object

Dim Part As Object
5 D7 N/ ^3 \# d1 t1 F( pDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
' M3 l  f& |2 d- {/ b! L$ c' F
: q: ?4 Y! T) a& }Sub main()
% J6 I3 Q# F( j0 ^2 f
# h0 q0 I# f) s% c2 E3 W" gSet swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
5 Q3 W2 j: z$ K. lDim CWAddinCallBackObj As Object
! m& n/ Q! T  X* M% t: n9 TSet CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
7 z$ \" I% J, ~) ?7 L, bSet 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)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
: }% Q, E( v8 K6 s6 ?3 FSet Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
" H. o% X7 C0 m. [8 o2 V1 c. J, FswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
( T# ^; Z5 j4 y5 u  ?* C9 T# P
! c: r  M6 s! |1 b' Redraw
, K- Y& L4 u- N5 D; Y: P' xPart.GraphicsRedraw2
- Z2 o( C; a! R( ]Set myModelView = Part.ActiveView
! a; w8 g+ v; ?. r* nmyModelView.FrameState = swWindowState_e.swWindowMaximized
, l8 g$ T7 ]7 z. a2 j) a# \Set CWAddinCallBackObj = Nothing
9 Q( y+ e. O2 N) G3 U6 sSet COSMOSWORKSObj = Nothing
End Sub
$ y8 W: R% r/ A/ s' z' m: o

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
3 \; b! j  @9 l- W* s9 O+ GDim swApp As Object
Dim Part As Object
# |7 ~; J" l" s  Q  U- bDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
* w8 l7 p4 X7 j. K/ ^0 iDim Filename As String
Dim No As Integer
Dim Title As String


Sub main()

Set swApp = Application.SldWorks
4 _1 a# q( c9 B. n3 bSet Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
' b" I, Z, v1 m# p8 aSet Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Filename = Part.GetPathName()
No = Len(Filename)
. Z0 D1 ]9 U; nFilename = Left(Filename, No - 7)
, x# Z. i/ r! d& B8 ?# y
% H) n+ z3 L' `8 l! C* @3 G- }4 USet Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
) p: @% _9 _! @Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
- a4 e* T6 J8 DSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub