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

arter_2006

各位大侠:
     想录个宏、设置成快捷键，实现无论在模型窗口选中零件的面、或在左侧区域（commandmanager区域）选中零件或装配体，再按快捷键，即可打开相应的工程图。实现此功能需先做个宏。可是不太成功。问题是：
1、报错；
2、宏里指定了零部件的名称，导致只能打开创建宏时的零件工程图。
! {) I! G  u0 {9 A6 M5 p
( G. d' V8 l8 ]9 t& Q0 I) E) z7 p/ e哪位高手能否指点下该如何修改这个宏？非常感谢！

arter_2006

改了一下，此附件不在报错，但是打开的是创建宏时的工程图，依然不行。
再改了一下，见下，启动宏没反应，也不报错，这个是SW2020的版本的宏
Dim swApp As Object
1 e3 R, l5 D4 O1 `6 Z! D
5 T- m' k) D" h0 `# F, l  tDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

' X" Y  }1 i* |$ x- [Sub main()
( `& ]( G' i# i* C2 Y
Set swApp = Application.SldWorks
( q( @( x, n1 O& C$ }( |) I  v( M
0 w# L6 f. @3 `9 w6 }: CSet Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
. G  o7 |: J9 b  c& yDim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
. l6 E* F1 r+ l: t6 x" Tboolstatus = 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
% q3 X3 T2 {) iSet swDrawing = Part
Set Part = swApp.ActiveDoc
1 y: V2 A) m0 x8 j& QDim myModelView As Object
' V0 B3 ^% q, [& w: p- TSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
& d2 w. Y2 d: {myModelView.FrameTop = 0
( G+ H' s: o! V* t+ FSet myModelView = Part.ActiveView
- I" U: B  ^, E+ g% g: N# @myModelView.FrameState = swWindowState_e.swWindowMaximized
* G  r' P5 p1 x: x1 gswApp.ActivateDoc2 "B111 PLT - 图纸1", False, longstatus
Set Part = swApp.ActiveDoc

! @2 |7 A6 w* Q% F' u3 ]' Redraw
. _/ D; Q" c6 W0 B( O2 dPart.GraphicsRedraw2
5 s) W% m- n' zSet myModelView = Part.ActiveView
' ], Q8 b6 R/ U* k' t; ?myModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
4 `' H" \) U$ J) R3 ?7 ?7 i  F4 {4 j& hEnd Sub

arter_2006

这个是SW2016的版本的宏，就差一步就成功了，就是如何从被选的零部件获得文件名。
Dim swApp As Object
Dim Part As Object
' z3 C2 g' u8 y$ u! nDim boolstatus As Boolean
6 e/ L1 ^+ i# L, Q0 [Dim longstatus As Long, longwarnings As Long
Dim Filename As String
3 O. ]" J; t4 Y. ZDim No As Integer
9 B" }2 T& P' u3 h- F* |1 gDim Title As String
1 c; F# d$ ]3 A" v6 n' m7 z

Sub main()
$ W/ e# I' p8 Q. d1 d1 L8 R8 [4 W
/ `* u/ `0 E+ |3 ISet swApp = Application.SldWorks
/ @# ^% z! C" U  `* R- lSet Part = swApp.ActiveDoc
: a; z" e( j% k; Uboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Set Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Filename = Part.GetPathName()
, M- [% ~. }! j! D+ D$ O6 }; {' VNo = Len(Filename)
. W; d" P" H( N+ VFilename = Left(Filename, No - 7)
! c" P8 B) i3 e6 [7 C! `% R
Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
8 r/ e  [: X$ `# a/ E& s+ X6 _: TSet Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
4 q1 S" y" S8 R) U1 H" EmyModelView.FrameLeft = 0
myModelView.FrameTop = 0
& ]! o: V5 a1 A+ a3 v0 k) LSet myModelView = Part.ActiveView
9 n# x: N. O7 `7 Q6 MmyModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
# d8 _  a) \0 [' n: ?myModelView.FrameState = swWindowState_e.swWindowMaximized
+ V/ V" a  b9 ~9 E% @End Sub

冷月梧桐

矫情，有个词叫“快捷键”，操作：你把”从零件/装配体到工程图“设置一个快捷键，比如Ctrl+1。
) P3 o9 N4 W: \4 R使用方法：你点中零件，按快捷键就好了

zhufeng_hgp

这个功能正如2楼说得那样，把打开工程图这个命令设置成快捷键就能实现的

czq001

好东西 学习一下

防弹蜗牛

零件和工程图并不是一一对应的
4 N2 i9 C0 d: |$ n0 u" u# V" i. f为啥，有配置，有出图的特殊需要
A零件可以对应工程图B，C，D。。。

所以，我觉得这个需求就不成立。。。

远祥

感谢楼主分享，学习了

1142

zhufeng_hgp 发表于 2022-1-26 23:08
这个功能正如2楼说得那样，把打开工程图这个命令设置成快捷键就能实现的

你好，请问你这个是从装配体选择零件，然后打开工程图的吗？如果是可以的也帮我发一下吧,谢谢！1142163586@qq.com
# x5 J" v3 {/ ~4 u

qiushui1688

已学习，多谢！