多张工程图分解为单张的工程图

小凡雪琪碧瑶

我用 的是2012版的SW，以前有人把一系列的工程图都做在一张图上了，这样的弊端是工程图能关联建模图，但是建模图跟工程图不关联，因此我想把它拆开，单独一张一张的，试问下，有没有方法。谢谢！
2 \6 C% x5 {) N6 z; M' q- b

大鹿

试答：重画

小凡雪琪碧瑶

不准备这么麻烦

杀苏

新建一空白图，复制过来

小凡雪琪碧瑶

对，我也是这样做的，但是图号什么的要重新修改，而且还要打包修改。

o1ojacko1o

这样的弊端是工程图能关联建模图，但是建模图跟工程图不关联，

您所说的 意思是 零件和工程图不关联吗？
3 A% H7 t, V0 u' R" t2 O' _- }
您所说的不关联 是几个意思？ 零件修改 工程图不跟着改动吗？

还是你打开零件 想直接通过零件打开对应的工程图打不开？
2 W; R. ]/ E4 R8 u3 ]0 |
如果是最后一个原因 你大可不必这么麻烦，高手前辈已经提供了对应的解决方法。

小凡雪琪碧瑶

是最后一个原因

bash

量很大的话，可以让懂VBA的朋友帮忙以零件名为基础拷贝出N分完整关联的单位，并且VBA中包含删除各图中不需要的视图的代码。然后再一张张整理版面。
& J* E$ l( K' _3 x# v- g' J量小的话，，楼上已经有答案！

NC@jiang@nan

1. Sub main()
   
2. Set swApp = Application.SldWorks
   . L7 h- H$ ^7 u
3. Set Model = swApp.ActiveDoc
   
4. If Model Is Nothing Then Exit Sub
   ; n$ O  R  Z; Q& W5 `
5. ModelPathName = Model.GetPathName
   . l3 x9 X, [6 {& p2 t& T5 W( }
6. ModelConfigName = swApp.GetActiveConfigurationName(ModelPathName) '當前模型的當前配置名稱
   
7. ModelPath = Left(ModelPathName, InStrRev(ModelPathName, ""))
     M. I# h4 F  o  e* i/ S
8. ModelName = Right(ModelPathName, Len(ModelPathName) - Len(ModelPath))
   # n" M$ A7 P) Z0 h  D8 {. ]
9. DrawingFileName = Dir(ModelPath & "*.slddrw") '獲取首個工程圖檔案名稱
   1 P0 J; v! m+ L, r7 ?
10. NoDrawingFound = True
    
11. Do Until DrawingFileName = "" '直至獲取到空值
    4 Q; V& C1 z5 X; ?3 ?: x
12.     traverse = False 'True
    6 C7 u; r/ n1 r
13.     Search = False
    
14.     addreadonlyinfo = False
    
15.     depends = swApp.GetDocumentDependencies2(ModelPath & DrawingFileName, traverse, Search, addreadonlyinfo) '工程圖含有的全部模型檔案名稱
    ; \3 [. A  q& `2 w
16.     WithModel = False
    
17.     If Not IsEmpty(depends) Then
    ! T1 L7 K4 Z5 T+ z- G! r: Y
18.         idx = 1
    
19.         While idx <= UBound(depends)
    
20.             If ModelPathName = depends(idx) Then WithModel = True '工程圖是否含有當前模型檔案名稱
    / Q  h/ }0 C! f( _1 T& v( e
21.             idx = idx + 2
    
22.         Wend
    
23.     End If
    $ c8 X% P8 k9 y" p
24.     If WithModel Then '是否含有當前模型檔案名稱
    * Q1 f+ Z/ v1 l- ?% m) J+ d# z
25.         Set Drawing = swApp.OpenDoc(ModelPath & DrawingFileName, 3) '開啟工程圖
    , T9 J0 M( {1 D1 V
26.         Dim longstatus As Long
    
27.         swApp.ActivateDoc2 DrawingFileName, False, longstatus  '顯示工程圖
    ; ?+ E- u6 O2 e7 L) Z$ F( m5 S/ C
28.         myViewss = Drawing.GetViews '所有視圖
    , e! h( V- a( D
29.         ModelConfigInDrawing = False
    : v7 |2 T9 W' {& R
30.         For i = 0 To UBound(myViewss) '每頁
    % ~6 r0 k4 Z# H% ?8 P3 T
31.             myViews = myViewss(i)
    
32.             SheetName = myViews(0).Name '每頁圖頁名稱
    
33.             ModelInSheet = False
    
34.             For J = 0 To UBound(myViews)
    
35.                 If ModelPathName = myViews(J).GetReferencedModelName And ModelConfigName = myViews(J).ReferencedConfiguration Then '模型檔名及配置名稱都吻合
    
36.                     ModelInSheet = True
    
37.                     ModelConfigInDrawing = True
    
38.                 End If
    6 N% q; E3 z. ?
39.             Next
    
40.             If ModelInSheet Then Drawing.ActivateSheet SheetName '跳到含有當前模型及配置的圖頁
    
41.         Next
    9 w) A% i1 H2 b6 w% z' }8 r; t
42.         If Not ModelConfigInDrawing Then '開啟了的工程圖不吻合所有條件
    ( _, L2 r; I; {. t% ?
43.             MsgBox "此工程圖雖然含有 " & ModelName & Chr(10) & "但沒有對應的配置 " & ModelConfigName '如覺得此提示信息有阻礙, 可整句刪除
    
44.             swApp.ActivateDoc2 ModelPathName, False, longstatus    '顯示本來的模型 (雖然開啟了的工程圖不吻合條件, 但必須保持開啟, 以免影響其他當前工作)
    $ N5 k% [4 X. y, u
45.         End If
    
46.         NoDrawingFound = False
    0 i/ R* ^) |  H& G. Y% q: y
47.     End If
    
48.     DrawingFileName = Dir '獲取下一個工程圖檔案名稱
    9 M/ G3 q3 |3 o9 }" O. p: i8 E
49. Loop '循環
    
50. If NoDrawingFound Then MsgBox "在資料夾 " & ModelPath & Chr(10) & "找不到含有 " & ModelName & " 的工程圖" '如覺得此提示信息有阻礙, 可整句刪除
    
51. End Sub
    

复制代码

. c1 X! D* i* A% f

1 }3 {- W" ^, n, f( @( N5 s) `如果楼主单纯为了能在打开模型时能打开相应的工程图的话，以上宏代码可以解决楼主的问题。这个是闷大的杰做，楼主去谢谢闷大。
如果说一定要把工程图文件存成单张的话，那我觉得把工程图文件另存为和模型名匹配的文件，然后把不属于这个模型的图页删除，这样可能更快点吧。