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

小凡雪琪碧瑶

我用 的是2012版的SW，以前有人把一系列的工程图都做在一张图上了，这样的弊端是工程图能关联建模图，但是建模图跟工程图不关联，因此我想把它拆开，单独一张一张的，试问下，有没有方法。谢谢！
  `2 \5 d& [8 n; J1 s! f

大鹿

试答：重画

小凡雪琪碧瑶

不准备这么麻烦

杀苏

新建一空白图，复制过来

小凡雪琪碧瑶

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

o1ojacko1o

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

您所说的 意思是 零件和工程图不关联吗？
( c9 V) Y8 i* L% e! m, f8 Z! b5 z
) \1 \* p* S' L; q* p您所说的不关联 是几个意思？ 零件修改 工程图不跟着改动吗？

还是你打开零件 想直接通过零件打开对应的工程图打不开？

2 S7 I$ }% S- |" B  z如果是最后一个原因 你大可不必这么麻烦，高手前辈已经提供了对应的解决方法。

小凡雪琪碧瑶

是最后一个原因

bash

量很大的话，可以让懂VBA的朋友帮忙以零件名为基础拷贝出N分完整关联的单位，并且VBA中包含删除各图中不需要的视图的代码。然后再一张张整理版面。
5 h) t8 g8 t( l, }: W; T$ Y" {量小的话，，楼上已经有答案！

NC@jiang@nan

1. Sub main()
   % l* u! }6 `6 P' e
2. Set swApp = Application.SldWorks
   3 ?% _* {) f, ^  l: I1 w
3. Set Model = swApp.ActiveDoc
   " X$ t- T- e6 O% a1 f5 k4 r
4. If Model Is Nothing Then Exit Sub
   
5. ModelPathName = Model.GetPathName
   
6. ModelConfigName = swApp.GetActiveConfigurationName(ModelPathName) '當前模型的當前配置名稱
   
7. ModelPath = Left(ModelPathName, InStrRev(ModelPathName, ""))
   
8. ModelName = Right(ModelPathName, Len(ModelPathName) - Len(ModelPath))
   
9. DrawingFileName = Dir(ModelPath & "*.slddrw") '獲取首個工程圖檔案名稱
   
10. NoDrawingFound = True
    
11. Do Until DrawingFileName = "" '直至獲取到空值
    
12.     traverse = False 'True
    % s3 s- R' T$ W2 }
13.     Search = False
    
14.     addreadonlyinfo = False
    % u% j& v, a7 ?$ z- H6 A; J
15.     depends = swApp.GetDocumentDependencies2(ModelPath & DrawingFileName, traverse, Search, addreadonlyinfo) '工程圖含有的全部模型檔案名稱
    
16.     WithModel = False
    
17.     If Not IsEmpty(depends) Then
    3 _3 y/ g0 ]9 u9 @: {
18.         idx = 1
    
19.         While idx <= UBound(depends)
    
20.             If ModelPathName = depends(idx) Then WithModel = True '工程圖是否含有當前模型檔案名稱
    1 F$ W# a- m9 e  s* m1 R1 K8 I
21.             idx = idx + 2
    2 v+ W% T$ U" y8 u! n+ H
22.         Wend
    ' X: P( Y$ c2 [! n! L) ^
23.     End If
    
24.     If WithModel Then '是否含有當前模型檔案名稱
    3 M- o6 K8 C& N. z$ ~& P
25.         Set Drawing = swApp.OpenDoc(ModelPath & DrawingFileName, 3) '開啟工程圖
    5 K: J! _' _) M: o
26.         Dim longstatus As Long
    2 e/ q3 D  B3 h, k" S+ n6 Q# C
27.         swApp.ActivateDoc2 DrawingFileName, False, longstatus  '顯示工程圖
      b$ m, j, I5 h: p+ x) @
28.         myViewss = Drawing.GetViews '所有視圖
    
29.         ModelConfigInDrawing = False
    ! X% Y* x$ b. l4 d
30.         For i = 0 To UBound(myViewss) '每頁
    
31.             myViews = myViewss(i)
    
32.             SheetName = myViews(0).Name '每頁圖頁名稱
      B4 H$ \: t2 u8 `: x; l
33.             ModelInSheet = False
    
34.             For J = 0 To UBound(myViews)
    & a1 }& |, ^( F( V( V
35.                 If ModelPathName = myViews(J).GetReferencedModelName And ModelConfigName = myViews(J).ReferencedConfiguration Then '模型檔名及配置名稱都吻合
    
36.                     ModelInSheet = True
    
37.                     ModelConfigInDrawing = True
    9 C9 g8 R$ {. |$ U
38.                 End If
    7 \: C8 u' j. x6 I2 K
39.             Next
      O3 W) |, ?' [3 B9 a
40.             If ModelInSheet Then Drawing.ActivateSheet SheetName '跳到含有當前模型及配置的圖頁
    
41.         Next
    5 v7 k) [" r/ d) T
42.         If Not ModelConfigInDrawing Then '開啟了的工程圖不吻合所有條件
    
43.             MsgBox "此工程圖雖然含有 " & ModelName & Chr(10) & "但沒有對應的配置 " & ModelConfigName '如覺得此提示信息有阻礙, 可整句刪除
    
44.             swApp.ActivateDoc2 ModelPathName, False, longstatus    '顯示本來的模型 (雖然開啟了的工程圖不吻合條件, 但必須保持開啟, 以免影響其他當前工作)
    2 i, w' d5 b' j" d0 j  x1 H
45.         End If
    
46.         NoDrawingFound = False
    
47.     End If
    
48.     DrawingFileName = Dir '獲取下一個工程圖檔案名稱
    
49. Loop '循環
    ( W5 _/ c/ j9 \5 p, r% F, j
50. If NoDrawingFound Then MsgBox "在資料夾 " & ModelPath & Chr(10) & "找不到含有 " & ModelName & " 的工程圖" '如覺得此提示信息有阻礙, 可整句刪除
    
51. End Sub
    

复制代码

( P9 a9 D2 G' {- E) t7 `9 r
如果楼主单纯为了能在打开模型时能打开相应的工程图的话，以上宏代码可以解决楼主的问题。这个是闷大的杰做，楼主去谢谢闷大。
如果说一定要把工程图文件存成单张的话，那我觉得把工程图文件另存为和模型名匹配的文件，然后把不属于这个模型的图页删除，这样可能更快点吧。