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

arter

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

arter

宏内容如下：

# t* L/ f& c4 }! g0 x
Dim swApp As Object

3 K' d; k$ h; L' E& k7 GDim Part As Object
% o- y8 h6 ^9 v+ R: H6 [$ FDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
% s) ~9 D. P8 a2 \
( d; C5 X* U2 X# i# xSub main()

7 r  J% T' ^$ D5 b7 ySet swApp = Application.SldWorks
' _+ p; C( H( s: _* ^" [9 C
Set Part = swApp.ActiveDoc
Dim SimulationWORKSObj As Object
8 y1 e$ g- I6 N  q5 h8 y0 JDim CWAddinCallBackObj As Object
, i2 E# z  [& m  d1 TSet CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
! }% Q$ Q0 A7 b* l9 t% R$ Y* G. lSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
' w+ F5 H. }  D5 ?6 E3 Kboolstatus = 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)
. T) Q- _) M+ Y  UDim swDrawing As DrawingDoc
Set swDrawing = Part
8 G/ F5 V: X) J" W6 K, lSet Part = swApp.ActiveDoc
Dim myModelView As Object
7 |- V% i- u+ G2 q) K, I( W8 wSet myModelView = Part.ActiveView
' N& @) L" _; Y; @9 W/ imyModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
/ Y/ a9 A2 t. |$ L9 I, Y  [- kSet Part = swApp.ActiveDoc

' Redraw
Part.GraphicsRedraw2
3 x( a) j0 _  ]2 lSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
- g% S) v/ N( K$ q% H3 K* aActiveDocObj = Nothing
Set CWAddinCallBackObj = Nothing
* d) v# C$ ~& \) {0 xSet SimulationWORKSObj = Nothing
7 L  o4 A9 T$ [5 V. {End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
# ?6 p0 A: @2 o( s/ b再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object
6 d' z4 l2 y5 ], U+ A
Dim Part As Object
Dim boolstatus As Boolean
' c0 g1 Z) H) ~" n$ D% ]Dim longstatus As Long, longwarnings As Long

) p* ]! D6 t7 H9 Z- V9 `# Y3 }Sub main()
. e  z5 }2 C6 b2 r1 G( J, X( @
6 E! p3 d+ t, _& s* uSet swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
* Y' U2 k, Q2 t, ]2 MDim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
1 ^9 ]' B8 b& o7 y0 W- t6 w! gSet CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
+ u! t; b% A# ~3 fSet COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
7 S9 Z3 p9 [) Z* \* oboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
$ A0 \4 a0 @- K: z" _1 {# H
' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
0 m+ s  n, [" l; Y4 ]1 a( vDim swDrawing As DrawingDoc
* D5 n: ~! b* ^! W7 G5 iSet swDrawing = Part
& W' g- b$ Q; |Set Part = swApp.ActiveDoc
& u4 g9 y) W; b7 @& V5 r, N3 pDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
- }/ s. q9 m& U& ^: QmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
' T, e+ h, o. @! A6 X* J8 PSet Part = swApp.ActiveDoc

' Redraw
Part.GraphicsRedraw2
1 @# V& e8 ~6 g/ r# CSet myModelView = Part.ActiveView
- T, z( r( ?+ _5 vmyModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
End Sub
' |5 l+ b5 ?0 x

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
1 h4 q* ?: Y- X6 q$ ]1 RDim swApp As Object
, ^. J. H6 V+ E9 A+ ODim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
% Q; V9 O9 ~$ f( E  e4 v+ \Dim Filename As String
Dim No As Integer
Dim Title As String
! x# d' r% k- E: z

: \1 h( k5 f* u8 l  V9 NSub main()

- V/ Y6 }3 J/ f$ |. R4 Y2 ]Set swApp = Application.SldWorks
8 ]. \5 v0 ~! F) u' r8 U/ OSet Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
' v6 L) Z, `4 D! Y' ?/ P+ K- {Set Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
, F5 h  ?3 |& y, m+ H1 n; U9 pFilename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
$ i! y! Y( |( @- n) p4 v3 d+ j
Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
( V; j" I9 E8 K+ `myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
/ g9 P2 q' ^: z  d7 wSet myModelView = Part.ActiveView
* C) s" e$ Y. W1 J4 i. V! amyModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub