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

arter_2006

各位大俠:
% A; V& `; X+ O& L9 v- @     想錄個宏、設置成快捷鍵，實現無論在模型窗口選中零件的面、或在左側區域（commandmanager區域）選中零件或裝配體，再按快捷鍵，即可打開相應的工程圖。實現此功能需先做個宏。可是不太成功。問題是：
1、報錯；
! i8 C/ [6 A$ `5 K- L8 m$ `! \2、宏里指定了零部件的名稱，導致只能打開創建宏時的零件工程圖。

哪位高手能否指點下該如何修改這個宏？非常感謝！

arter_2006

改了一下，此附件不在報錯，但是打開的是創建宏時的工程圖，依然不行。
再改了一下，見下，啟動宏沒反應，也不報錯，這個是SW2020的版本的宏
Dim swApp As Object
& M4 @$ M# s8 O$ q, F) N3 {! C
Dim Part As Object
Dim boolstatus As Boolean
; U0 {5 ^: Q: `0 ^' A) S2 e& w9 g& LDim longstatus As Long, longwarnings As Long
  a) A' G0 V/ G2 n
" }0 y( }; ^; u, D+ F- f. fSub main()

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Dim COSMOSWORKSObj As Object
" Q$ J* Y* Q" U& o# EDim CWAddinCallBackObj As Object
Set CWAddinCallBackObj = swApp.GetAddInObject("CosmosWorks.CosmosWorks")
* e: g# S) A$ ^Set COSMOSWORKSObj = CWAddinCallBackObj.COSMOSWORKS
4 i% B4 T* ~5 Y! Qboolstatus = Part.Extension.SelectByID2("B111 PLT-1@B000  AAA", "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)

. o' R: }, `2 z4 R2 |( f" X) i' Open
+ q) \- U' M% o7 i8 nSet Part = swApp.OpenDoc6("C:\Users\COMPASSION\Desktop\宏\B111 PLT.SLDDRW", 3, 0, "", longstatus, longwarnings)
Dim swDrawing As DrawingDoc
Set swDrawing = Part
4 f, w" A% v! K3 RSet Part = swApp.ActiveDoc
  [( C: h0 d, U" D" |6 i  K- fDim myModelView As Object
$ X" N4 l7 j1 c+ o; w' nSet myModelView = Part.ActiveView
myModelView.FrameLeft = 0
. d: j" U0 O1 q9 n: ]2 [myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.ActivateDoc2 "B111 PLT - 圖紙1", False, longstatus
Set Part = swApp.ActiveDoc

- J8 B4 _$ f! s5 P4 w4 V& }& a' [' Redraw
Part.GraphicsRedraw2
! k) W' h( [3 d$ `/ S  r* a, cSet myModelView = Part.ActiveView
' g* `) a5 X: q7 C3 r5 `  NmyModelView.FrameState = swWindowState_e.swWindowMaximized
Set CWAddinCallBackObj = Nothing
Set COSMOSWORKSObj = Nothing
4 }+ I  Q1 m. C& LEnd Sub

arter_2006

這個是SW2016的版本的宏，就差一步就成功了，就是如何從被選的零部件獲得文件名。
4 `/ k2 V/ V! \. p% Y$ k  c- NDim swApp As Object
2 Z7 [. h; J% N: j7 \' ?. NDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
9 w' \& S" l/ w, l9 h# |. YDim Filename As String
6 I# `0 k. d9 d# O1 NDim No As Integer
Dim Title As String

  A. H! u) K1 q/ i6 _4 @' P5 a; Q5 @2 p
Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = 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()
No = Len(Filename)
Filename = Left(Filename, No - 7)

Set Part = swApp.OpenDoc6(Filename & ".SLDDRW", 3, 0, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
# _, Z+ `& ]& a6 dDim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameLeft = 0
myModelView.FrameTop = 0
Set myModelView = Part.ActiveView
) C& W1 X3 `. X1 e9 E8 fmyModelView.FrameState = swWindowState_e.swWindowMaximized
Set Part = swApp.ActiveDoc
1 q. K2 s9 S9 E& N6 ASet myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
3 C3 j! c6 w$ @, P% J6 {0 d* f4 mEnd Sub

冷月梧桐

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

zhufeng_hgp

這個功能正如2樓說得那樣，把打開工程圖這個命令設置成快捷鍵就能實現的

czq001

好東西 學習一下

防彈蝸牛

零件和工程圖并不是一一對應的
為啥，有配置，有出圖的特殊需要
) j& Q, c+ S$ [) eA零件可以對應工程圖B，C，D。。。

2 _8 O8 g$ f! b" f所以，我覺得這個需求就不成立。。。

遠祥

感謝樓主分享，學習了

1142

zhufeng_hgp 發表于 2022-1-26 23:08
這個功能正如2樓說得那樣，把打開工程圖這個命令設置成快捷鍵就能實現的

你好，請問你這個是從裝配體選擇零件，然后打開工程圖的嗎？如果是可以的也幫我發一下吧,謝謝！1142163586@qq.com
' o4 ~5 j5 q+ O+ v6 M7 Z

qiushui1688

已學習，多謝！