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

arter

各位大侠:      想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 1、报错； 4 Q" Z$ v4 F/ @, ^2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 哪位高手能否指点下该如何修改这个宏？非常感谢！ ( T# d* s& W0 \  H5 J $ }- u. M; m8 \/ C8 Y  }; v

arter

宏内容如下：


Dim swApp As Object
9 M$ D% k# L5 L6 f
Dim Part As Object
( O$ ]5 d- X9 g1 P+ HDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

- h# J$ b, d9 `' USub main()
  h3 f6 P& a8 c; F' E
Set swApp = Application.SldWorks

9 D* L9 d4 J% d0 Z9 jSet Part = swApp.ActiveDoc
! d9 o5 a: k3 Y3 ^( RDim SimulationWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
# p3 v4 s3 [; ^6 C0 o2 i3 B& P3 x, M. BSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
/ i1 m' R4 B, Hboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

7 A) V/ t+ z. `- f( P6 ]' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
6 _9 t- p0 B& L2 }Set swDrawing = Part
; U( f8 h! R& |  d8 ySet Part = swApp.ActiveDoc
Dim myModelView As Object
6 v/ W3 `2 e7 Z9 n  @/ hSet myModelView = Part.ActiveView
1 P2 u' i7 @# z$ P0 {. g1 [+ ?myModelView.FrameLeft = 0
* p$ v7 O9 X5 e/ }& RmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
& w3 a0 A" A3 Z% U) Z3 hSet Part = swApp.ActiveDoc

' Redraw
1 E" a$ z% k) u' `! _Part.GraphicsRedraw2
Set myModelView = Part.ActiveView
# t: {7 Z3 w0 F: Z$ B, G- ImyModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
7 a% z/ c* [* b: L- qSet CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
3 w0 H( \" N" }- }) ?, ]+ C4 qEnd Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
3 }, E1 `7 Z+ H0 m' A- FDim swApp As Object
! X& P4 y+ r# J$ G: W
Dim Part As Object
% x: I. C0 L5 [Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
" v7 M0 N5 n' z1 I* w
: e4 ]: |0 B8 }! `$ s1 e, wSub main()
. v9 d# d7 u, {* H3 Q5 ^0 x8 F5 c3 J0 r
1 G! r6 U: h5 v7 L3 rSet swApp = Application.SldWorks
0 ~- N. S/ D, ~" w: Z* R) o& A' h
Set Part = swApp.ActiveDoc
$ s; H4 F& X, pDim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
* ^. a) b; `8 L& E" oSet 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)
% L' E( I- T- z0 |6 T7 A3 TDim swDrawing As DrawingDoc
" u! H4 Q  h1 i9 x' G: ^Set swDrawing = Part
  C5 ?) ^* {% N3 {7 uSet Part = swApp.ActiveDoc
) s0 N4 }' w! r9 V& Y) rDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
% T+ F3 d- J6 G+ F1 ~# L2 F! ]myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
$ [2 C* Q1 s: L' ]+ tmyModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

& F" F$ g- X5 t( U' Redraw
Part.GraphicsRedraw2
% I& r  j7 `' g6 NSet myModelView = Part.ActiveView
" b: m3 |" c1 _3 d3 P5 @myModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
! a$ I( M; j# y: y" F$ P4 {2 q; ]Set COSMOSWORKSObj = Nothing
End Sub

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
  v4 g- E- W! x$ f6 Q2 q/ v! K( TDim swApp As Object
+ l' ^+ Y; W! u$ y- S/ fDim Part As Object
Dim boolstatus As Boolean
, d7 L0 `0 [% I1 z! b- ]$ mDim longstatus As Long, longwarnings As Long
# P* K! k& q" ADim Filename As String
7 `5 v  A, w" f: Z" \8 VDim No As Integer
! j4 d& [' L9 Y( p- aDim Title As String

( L- o" b2 j3 g
+ G5 x# k5 j- C$ H4 v; rSub main()
, V7 z0 F) s+ d8 {: d
3 {, j4 f$ m. MSet swApp = Application.SldWorks
5 u3 Q6 S4 D& S, }8 cSet Part = swApp.ActiveDoc
- O' j8 F! e; o$ C( s( kboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
7 C6 _. ~% B0 W; c5 F1 G7 QSet Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
+ ], w: Z% E6 t- X' L) R* q! c" kFilename = Part.GetPathName()
0 R9 x# m- a9 `7 z- _( a2 N1 _5 bNo = Len(Filename)
2 y  J* F% ]5 n7 R# U7 HFilename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
, R7 G4 M0 c( r3 c; ySet Part = swApp.ActiveDoc
Dim myModelView As Object
/ K: I% R( {/ o8 [- l4 h+ kSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
4 U- y& g1 F) ~7 E' L9 v2 LmyModelView.FrameState = swWindowState_e.swWindowMaximized
3 Y& j5 V5 i3 n% H& PSet Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub