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

arter

各位大侠: " G. }; S) A5 I# N6 @     想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是： 3 P) A/ ]) C; _# }: N1 _+ C1、报错； 2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。 2 x5 r: _! K5 R- V ' D- e' M1 F, j: R$ z3 @1 ^哪位高手能否指点下该如何修改这个宏？非常感谢！ ! |9 `* e9 w3 {7 m2 }6 ?4 ]$ D2 |

2 ]) m* E* v4 @2 N, P8 u  u

arter

宏内容如下：


Dim swApp As Object
) S: _' S+ k# X8 J5 p4 K4 C, N
; G, _2 j5 L8 E2 `7 l( FDim Part As Object
Dim boolstatus As Boolean
; x7 l2 W7 t; O" xDim longstatus As Long, longwarnings As Long
2 Z' S2 I- U% q# o9 ^: B
Sub main()

Set swApp = Application.SldWorks
; O2 d; N5 ~# e; q% Z, K( Y
% ~1 p- Q0 d& F, c5 Q8 f" [Set Part = swApp.ActiveDoc
Dim SimulationWORKSObj As Object
; h( E2 K& b4 XDim CWAddinCallBackObj As Object
/ b% s) y# G8 i0 NSet CWAddinCallBackObj = swApp.GetAddInObject("SimulationWorks.SimulationWorks")
! W0 L2 j3 ]1 KSet SimulationWORKSObj = CWAddinCallBackObj.SimulationWORKS
boolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

' Open
8 f8 Y$ D) H5 w. |% B5 SSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
  `  `1 t6 k# |% ADim swDrawing As DrawingDoc
$ ^7 C' K7 _+ _, ASet swDrawing = Part
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
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc
1 g- [; {: ~7 l- u: A
! V' H" G6 S! I& S' Redraw
2 j" n& W" i! y# _  k3 YPart.GraphicsRedraw2
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
StudyManagerObj = Nothing
ActiveDocObj = Nothing
+ Z, O* E) \" ]+ V6 C! @; E, YSet CWAddinCallBackObj = Nothing
Set SimulationWORKSObj = Nothing
! C: F( E/ ^( g1 `! K8 [End Sub

arter

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
6 H: g" O5 K. \1 v再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object

: p: M! L' p. UDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
: v$ U, ^, n0 J5 u
Sub main()

' r3 K) V; O& t4 A: j  K) CSet swApp = Application.SldWorks
3 X: o/ B0 P$ y- P
( _8 [  z6 @! j1 u* J1 zSet Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
4 E4 p) K" Q3 a) dSet COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
boolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
( i: Q! j2 O& L  F8 T* [
" B( `7 D: [* D& g1 i' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
5 q% C+ N. [5 m, |2 `9 H, uSet swDrawing = Part
Set Part = swApp.ActiveDoc
& s  q% ^2 x, ]! ^- D, zDim myModelView As Object
Set myModelView = Part.ActiveView
' n( p0 J; n$ |& X/ A$ `) u1 G4 lmyModelView.FrameLeft = 0
1 Z& w9 z9 d, G" E5 xmyModelView.FrameTop = 0
! a/ H( b( k' aSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

' Redraw
Part.GraphicsRedraw2
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
9 G' F# O4 U5 pSet CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
7 P# `" Z! ]; |5 iEnd Sub

arter

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
0 A1 ]& N2 d) |' g# B  gDim Part As Object
" z" u% l  k. GDim boolstatus As Boolean
6 N6 v, I  A" Q) n8 oDim longstatus As Long, longwarnings As Long
1 `$ b4 q# `: ?  S- y% Y# W+ PDim Filename As String
Dim No As Integer
8 G) p5 ?- k0 O/ d! w; m$ |" ~Dim Title As String

# Q) f5 k1 b" a: _4 w
6 R/ r2 y8 H! J+ B  r" q% KSub main()
3 X, G- O* ~2 t3 x9 g* a
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
6 L! E; t4 A6 L7 Qboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
1 k+ M! S: A% ~7 YSet Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
. c# l' h: ?+ i8 _' FFilename = Part.GetPathName()
3 C1 `! U' O+ V! {No = Len(Filename)
Filename = Left(Filename, No - 7)
( X1 y: ]! Q3 x# l3 a
( b1 v" t( v4 YSet Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
0 @) w. n, Q" H) s$ Z* JDim myModelView As Object
5 s; ~. Q+ B1 {Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
( s+ y" t5 D7 T8 j$ xmyModelView.FrameTop = 0
( f6 K: @& Q+ K7 n4 QSet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
" X. S* r  F1 c1 OmyModelView.FrameState = swWindowState_e.swWindowMaximized
End Sub
: h6 ^& N0 `" T* }7 U1 ?3 Y" g