“快速打開零部件工程圖的宏”的問題

arter_2006

各位大俠:
3 N9 i, _. d0 s+ H7 z     想錄個(gè)宏、設(shè)置成快捷鍵，實(shí)現(xiàn)無論在模型窗口選中零件的面、或在左側(cè)區(qū)域（commandmanager區(qū)域）選中零件或裝配體，再按快捷鍵，即可打開相應(yīng)的工程圖。實(shí)現(xiàn)此功能需先做個(gè)宏。可是不太成功。問題是：
1、報(bào)錯(cuò)；
+ ], i! |; t$ Y0 o4 A( @5 d$ @2、宏里指定了零部件的名稱，導(dǎo)致只能打開創(chuàng)建宏時(shí)的零件工程圖。

8 U; h% ?; w( N) A哪位高手能否指點(diǎn)下該如何修改這個(gè)宏？非常感謝！
8 N: `/ ]( k0 o, H; c* K# I

arter_2006

改了一下，此附件不在報(bào)錯(cuò)，但是打開的是創(chuàng)建宏時(shí)的工程圖，依然不行。
再改了一下，見下，啟動(dòng)宏沒反應(yīng)，也不報(bào)錯(cuò)，這個(gè)是SW2020的版本的宏
3 c! z/ ]- d+ x7 ~) m2 {9 aDim swApp As Object

& C/ x. E3 K2 ~, BDim Part As Object
, ?; z$ t* V% G) T- `Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
; r8 u/ L/ I9 k
Sub main()
6 P8 ?/ y" P. E- c1 r0 v: X1 H
Set swApp = Application.SldWorks
0 ]6 q2 f: P2 k2 Z& q) M& G0 ^! L0 c
, c- L2 i% B/ u& XSet Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
Dim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
+ E) ~% s! I. d* nSet COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
3 a# O; s+ [4 L% }3 C+ ]# A0 iboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

4 H1 L1 x% r8 l, v* ?- K4 z" k' Open
Set Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
Set Part = swApp.ActiveDoc
0 b; u, Z- O+ P4 ]: gDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
, h% J. F5 a% x0 O1 OmyModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 圖紙1", False, longstatus
Set Part = swApp.ActiveDoc
6 K0 K" E( k& c$ g6 \& q
  o- Y& s! K6 J) `' Redraw
Part.GraphicsRedraw2
+ d, }$ A. P9 SSet myModelView = Part.ActiveView
2 }9 k) S- n- umyModelView.FrameState = swWindowState_e.swWindowMaximized
# x( v* S/ C- BSet CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
6 U+ ]9 E( y4 E8 L' QEnd Sub

arter_2006

這個(gè)是SW2016的版本的宏，就差一步就成功了，就是如何從被選的零部件獲得文件名。
Dim swApp As Object
/ H- o% X2 N" O) g; W! |Dim Part As Object
Dim boolstatus As Boolean
7 X- H  o0 y. tDim longstatus As Long, longwarnings As Long
Dim Filename As String
Dim No As Integer
" a* ?( I0 R4 J* ?7 PDim Title As String

1 P# S) x: e- d' D! {
7 ?9 S. e# `' H! [" a1 [* _Sub main()
5 M$ `: j& y8 K
2 c+ G+ L+ q9 [' ]% l! XSet swApp = Application.SldWorks
" \; W4 m+ M  P% {8 qSet Part = swApp.ActiveDoc
& S* E- a5 S1 xboolstatus = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
1 N% d+ e) k6 R1 U6 ?6 ~Set Part = Part.Extension.SelectByID2("Part", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
Filename = Part.GetPathName()
' n$ L/ z! W* lNo = Len(Filename)
# m4 \: K! Z1 Q; p& L& aFilename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
/ N, y3 ^6 [$ s) X. oSet Part = swApp.ActiveDoc
1 \2 i" Q" }! u* J2 iDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
  U* f  q6 h3 ?8 r# [5 O6 O% a4 USet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
: U" s( w# _3 D9 ?. D9 ISet Part = swApp.ActiveDoc
Set myModelView = Part.ActiveView
* V7 x' S; ?2 D: pmyModelView.FrameState = swWindowState_e.swWindowMaximized
& h% X' y* |+ t( sEnd Sub

冷月梧桐

矯情，有個(gè)詞叫“快捷鍵”，操作：你把”從零件/裝配體到工程圖“設(shè)置一個(gè)快捷鍵，比如Ctrl+1。
使用方法：你點(diǎn)中零件，按快捷鍵就好了

zhufeng_hgp

這個(gè)功能正如2樓說得那樣，把打開工程圖這個(gè)命令設(shè)置成快捷鍵就能實(shí)現(xiàn)的

czq001

好東西 學(xué)習(xí)一下

防彈蝸牛

零件和工程圖并不是一一對(duì)應(yīng)的
為啥，有配置，有出圖的特殊需要
7 l+ _8 I- K( |) V/ u7 e1 \A零件可以對(duì)應(yīng)工程圖B，C，D。。。

所以，我覺得這個(gè)需求就不成立。。。

遠(yuǎn)祥

感謝樓主分享，學(xué)習(xí)了

1142

zhufeng_hgp 發(fā)表于 2022-1-26 23:08
這個(gè)功能正如2樓說得那樣，把打開工程圖這個(gè)命令設(shè)置成快捷鍵就能實(shí)現(xiàn)的

( C  _6 d, w( B  ]: i$ M你好，請(qǐng)問你這個(gè)是從裝配體選擇零件，然后打開工程圖的嗎？如果是可以的也幫我發(fā)一下吧,謝謝！1142163586@qq.com

qiushui1688

已學(xué)習(xí)，多謝！