VBA 多文档打印问题。

huaxiamengqing

多文档转换出来问题。自己电脑上要加msgbox "是否继续", 才能正常多文档打印，别人电脑上可以正常打印，为啥？
I write a code for CAD batch plot,the main code of  the pass for different dwg is
below.

2. Public Sub dylst(strPath, Flag As Boolean, Optional Mlstr1 As String = "忽略",
   
3. 
   
4. Optional Mlstr2 As String = "忽略")
   
5.     Dim Mnew As AcadDocument
   
6.     Dim Tkdoc As AcadSelectionSet, Mstr As String
   
7.         Set Mnew = ThisDrawing.Application.Documents.Open(strPath, ReadOnly) '只
   
8. 
   
9. 读方式打开图形
   
10.        ' MsgBox "是否继续打印？"
    
11.          BuildFilter pType, pData, 2, Mainfrm.TextBox1.Text '建立图块过滤器
    
12.          
    
13.          For Each Tkdoc In Mnew.SelectionSets
    
14.               If Tkdoc.Name = "Tkdoc" Then
    
15.                   Tkdoc.Delete
    
16.                   Exit For
    
17.               End If
    
18.          Next
    
19.          
    
20.          Set Tkdoc = Mnew.SelectionSets.Add("Tkdoc")
    
21.          
    
22.             Mnew.SetVariable "REGENMODE", 1 '防止图纸大的时候缩放出现提示
    
23.             Mnew.Application.ZoomExtents
    
24.            
    
25.             Tkdoc.Select acSelectionSetAll, , , pType, pData
    
26.             
    
27.            If Mlstr1 = "忽略" Then
    
28.                   Dy Tkdoc, Flag, Mnew
    
29.             Else
    
30.                   'Debug.Print "执行！"
    
31.                   Dy Tkdoc, Flag, Mnew, Mlstr1, Mlstr2
    
32.             End If
    
33.             Mnew.Close False
    
34.             Tkdoc.Delete
    
35. End Sub I my computer  I test it  in CAD 2008 and CAD 2012 ,It opens  alll  the
    
36. 
    
37. dwg in the list and nothing of the code "dy" excute.
    
38. 
    
39. Set Mnew = ThisDrawing.Application.Documents.Open(strPath, ReadOnly) '只读方式打
    
40. 
    
41. 开图形
    
42. 
    
43. "dy"  is the module i write for plot a single dwg.
    
44. 
    
45. But if i add the code of "MsgBox "Continue?" " i t works well !  and in some
    
46. 
    
47. other computer it also works well without the code of "MsgBox "Continue?" " . I
    
48. 
    
49. was so confused about this problem. do you have  run into the same  situation?
    
50. 
    
51. Can you give me some advice? Thank you very very much!
    
52. 
    
53. more code  below:
    
54. 
    
55.     ' lstdic is a dictionary object of the dwg pathstr.
    
56.     For Each key In Lstdic
    
57.             i = i + 1
    
58.             Label1.Caption = "正在打印第" & i & "张图共（" & Lstdic.Count & "张)"
    
59. 
    
60. & vbCrLf
    
61.             dylst key, True
    
62.      Next
    
63. 
    

Public Sub dylst(strPath, Flag As Boolean, Optional Mlstr1 As String = "忽略", <br /> <br /> Optional Mlstr2 As String = "忽略")<br />     Dim Mnew As AcadDocument<br />     Dim Tkdoc As AcadSelectionSet, Mstr As String<br />         Set Mnew = ThisDrawing.Application.Documents.Open(strPath, ReadOnly) '只<br /> <br /> 读方式打开图形<br />        ' MsgBox "是否继续打印？"<br />          BuildFilter pType, pData, 2, Mainfrm.TextBox1.Text '建立图块过滤器<br />           <br />          For Each Tkdoc In Mnew.SelectionSets<br />               If Tkdoc.Name = "Tkdoc" Then<br />                   Tkdoc.Delete<br />                   Exit For<br />               End If<br />          Next<br />           <br />          Set Tkdoc = Mnew.SelectionSets.Add("Tkdoc")<br />           <br />             Mnew.SetVariable "REGENMODE", 1 '防止图纸大的时候缩放出现提示<br />             Mnew.Application.ZoomExtents<br />            <br />             Tkdoc.Select acSelectionSetAll, , , pType, pData<br />             <br />            If Mlstr1 = "忽略" Then<br />                   Dy Tkdoc, Flag, Mnew<br />             Else<br />                   'Debug.Print "执行！"<br />                   Dy Tkdoc, Flag, Mnew, Mlstr1, Mlstr2<br />             End If<br />             Mnew.Close False<br />             Tkdoc.Delete<br /> End Sub I my computer  I test it  in CAD 2008 and CAD 2012 ,It opens  alll  the <br /> <br /> dwg in the list and nothing of the code "dy" excute.<br /> <br /> Set Mnew = ThisDrawing.Application.Documents.Open(strPath, ReadOnly) '只读方式打<br /> <br /> 开图形<br /> <br /> "dy"  is the module i write for plot a single dwg.<br /> <br /> But if i add the code of "MsgBox "Continue?" " i t works well !  and in some <br /> <br /> other computer it also works well without the code of "MsgBox "Continue?" " . I <br /> <br /> was so confused about this problem. do you have  run into the same  situation? <br /> <br /> Can you give me some advice? Thank you very very much!<br /> <br /> more code  below:<br /> <br />     ' lstdic is a dictionary object of the dwg pathstr.<br />     For Each key In Lstdic<br />             i = i + 1<br />             Label1.Caption = "正在打印第" & i & "张图共（" & Lstdic.Count & "张)" <br /> <br /> & vbCrLf<br />             dylst key, True<br />      Next<br /> <br />

I my computer  I test it  in CAD 2008 and CAD 2012 ,It opens  alll  the dwg in the list and nothing of the code "dy" excute.
Set Mnew = ThisDrawing.Application.Documents.Open(strPath, ReadOnly) '只读方式打开图形
"dy"  is the module i write for plot a single dwg.
But if i add the code of "MsgBox "Continue?" " i t works well !  and in some other computer it also works well without the code of "MsgBox "Continue?" " . I was so confused about this problem. do you have  run into the same  situation? Can you give me some advice? Thank you very very much!

' dy module

2. Public Sub Dy(SSt As AcadSelectionSet, Flag As Boolean, Optional Doc As
   
3. 
   
4. AcadDocument, Optional Mlstr1 As String = "忽略", Optional Mlstr2 As String = "忽
   
5. 
   
6. 略")
   
7.     Dim i As Integer, j As Integer
   
8.     Dim Ent As AcadEntity, Mtk As AcadBlockReference
   
9.     Dim GTstr As String, Plotstr As String
   
10.     Dim Low As Variant, Upp As Variant
    
11.     Dim Mastr As String, Mistr As String, Mip, Map
    
12.     Dim ACADLayout As ACADLayout
    
13.     Dim Toustr As String '显示进度条
    
14.     Dim Att As AcadAttribute
    
15.     Dim Mydic As Scripting.Dictionary '创建属性字典，以句柄为主键,以一个储存此Id
    
16. 
    
17. 内属性的字典为item
    
18.     Dim Filstr As String '输出的文件名
    
19.     Dim Setoutlst As Variant, Setoutstr(1 To 1) As String
    
20.     Dim ATTstr As String
    
21.   'On Error Resume Next
    
22. '在块没有改变前，以其句柄为key建立一个有关其属性的字典（因为所删非打印层也有属性
    
23. 
    
24. ）
    
25. '********************************************************************************
    
26. 
    
27. *******
    
28.       Set Mydic = CreateObject("Scripting.Dictionary")
    
29.       If Mlstr1 <> "忽略" Then '说明此参数没有被忽略，再进行分图或者批打到文件
    
30.                For Each Mtk In SSt
    
31.                    ATTstr = ""
    
32.                    Atts = Mtk.GetAttributes
    
33.                       For i = 0 To UBound(Atts)
    
34.                             ATTstr = ATTstr & Atts(i).TagString & Chr(174) &
    
35. 
    
36. Atts(i).TextString & vbLf
    
37.                       Next
    
38.                       ATTstr = ATTstr & "块名" & Chr(174) & Mtk.EffectiveName &
    
39. 
    
40. vbLf
    
41.                       Mydic.Add Mtk.Handle, ATTstr
    
42.                Next
    
43.       End If
    
44. '********************************************************************************
    
45. 
    
46. *******
    
47. 
    
48.    Doc.StartUndoMark '设置U回点
    
49.    
    
50. '删除块内非打印层并进行同步
    
51. '********************************************************************************
    
52. 
    
53. *******
    
54.                 For Each Ent In Doc.Blocks(Mainfrm.TextBox1.Text)
    
55.                      If Doc.Layers(Ent.Layer).Plottable = False Then
    
56.                         Ent.Delete
    
57.                      End If
    
58.                 Next
    
59.                 Doc.SendCommand "ATTSYNC N " & Mainfrm.TextBox1.Text & Chr(13)
    
60.                 Doc.Regen acActiveViewport
    
61.                 Doc.SetVariable "REGENMODE", 1 '防止图纸大的时候缩放出现提示
    
62.                 Doc.SetVariable "BACKGROUNDPLOT", 0 ' 确保AutoCAD在前台进行打印，
    
63. 
    
64. 这样后一次打印会在前一次打印完成之后才开始,避免出现错误
    
65.                 Doc.Application.ZoomExtents
    
66. '********************************************************************************
    
67. 
    
68. *******
    
69. 
    
70.             j = 0 '打印或者预览初始值
    
71.                Doc.ActiveLayout.CopyFrom Mpig '复制打印设置
    
72.                Doc.ActiveLayout.CenterPlot = True
    
73.                Doc.ActiveLayout.RefreshPlotDeviceInfo
    
74.                Doc.Regen acAllViewports
    
75. '传递打印设置Mylayout到DOC.layouts("Model")
    
76. '********************************************************************************
    
77. 
    
78. *******
    
79.            'Debug.Print Doc.ActiveLayout.Name
    
80. '            With Doc.ActiveLayout
    
81. '                  .CenterPlot = True '居中打印
    
82. '                  .ConfigName = Mylayout.ConfigName '打印机配置名称
    
83. '                  .PaperUnits = Mylayout.PaperUnits '纸张单位
    
84. '                  .PlotWithLineweights = Mylayout.PlotWithLineweights
    
85. '                  .PlotWithPlotStyles = Mylayout.PlotWithPlotStyles
    
86. '                  .ScaleLineweights = Mylayout.ScaleLineweights
    
87. '                  .StyleSheet = Mylayout.StyleSheet
    
88. '                  '.UseStandardScale = Mylayout.UseStandardScales
    
89. '            End With
    
90. '********************************************************************************
    
91. 
    
92. *******
    
93. 
    
94. '批量打印的时候需要设置
    
95. '********************************************************************************
    
96. 
    
97. *******
    
98. '            If Flag = True Then
    
99. '                Doc.Plot.QuietErrorMode = True
    
100. '                Doc.Plot.StartBatchMode SSt.Count '调出批打模式
     
101. '                Setoutstr(1) = "Model"
     
102. '                Setoutlst = Setoutstr
     
103. '                Doc.Plot.SetLayoutsToPlot Setoutlst
     
104. '            End If
     
105. '********************************************************************************
     
106. 
     
107. *******
     
108. 
     
109.             Toustr = Mainfrm.Label1.Caption '记录进度标签内容
     
110.             
     
111. 'SSt是一个图框图块的选择集，遍历此选择集，建立打印窗口
     
112. '********************************************************************************
     
113. 
     
114. *******
     
115.        For Each Mtk In SSt
     
116. 
     
117. '批量打印的时候需要设置
     
118. '********************************************************************************
     
119. 
     
120. *******
     
121.             If Flag = True Then
     
122.                ' Doc.Plot.QuietErrorMode = True
     
123.                 Doc.Plot.StartBatchMode SSt.Count '调出批打模式
     
124.                 Setoutstr(1) = Doc.ActiveLayout.Name
     
125.                 Setoutlst = Setoutstr
     
126.                 Doc.Plot.SetLayoutsToPlot Setoutlst
     
127.             End If
     
128. 
     
129. '********************************************************************************
     
130. 
     
131. *******
     
132. 
     
133. '打印pdf或者分图的时候需要传递此参数进行文件名字的设置
     
134. '********************************************************************************
     
135. 
     
136. *******
     
137.         If Mlstr1 <> "忽略" Then '说明此参数没有被忽略，再进行分图或者批打到文件
     
138.             Dim Marr, Mi As Integer, Ui As Integer, Ni As Integer
     
139.             Dim Mtemstr As String, Thisatt As New Scripting.Dictionary
     
140.               Filstr = Mlstr1
     
141.               Marr = Split(Mydic(Mtk.Handle), vbLf) '取出字符串 0开头
     
142.               Ui = UBound(Marr)
     
143.               For Mi = 0 To Ui - 1
     
144.                     Thisatt.Add Split(Marr(Mi), Chr(174))(0), Split(Marr(Mi),
     
145. 
     
146. Chr(174))(1)
     
147.               Next
     
148.                For Mi = 0 To Ui - 1
     
149.    
     
150.                     For Ni = Mi + 1 To Ui - 1
     
151.                          If Len(Split(Marr(Ni), Chr(174))(0)) > Len(Split(Marr
     
152. 
     
153. (Mi), Chr(174))(0)) Then
     
154.                                 Mtemstr = Marr(Mi)
     
155.                                 Marr(Mi) = Marr(Ni)
     
156.                                 Marr(Ni) = Mtemstr
     
157.                          End If
     
158.                        
     
159.                     Next
     
160.                     
     
161.               Next
     
162.               For Mi = 0 To Ui - 1
     
163.                   Filstr = Replace(Filstr, Split(Marr(Mi), Chr(174))(0), Thisatt
     
164. 
     
165. (Split(Marr(Mi), Chr(174))(0)))
     
166.                   '此处会出现bug,比如前面一个Item后面一个key值一样
     
167.                   '则会使item变成后面一个key的item(以后再消除此bug)
     
168.               Next
     
169.               Thisatt.RemoveAll
     
170.               Set Thisatt = Nothing '清空字典
     
171.         End If
     
172. '********************************************************************************
     
173. 
     
174. *******
     
175. 
     
176. '获得处理后的块box边界，设置窗口打印范围，并设置视口使打印或者预览范围可见
     
177. '********************************************************************************
     
178. 
     
179. *******
     
180.             Mtk.GetBoundingBox Mip, Map
     
181.             'Doc.ModelSpace.AddLine Mip, Map
     
182.             If Flag = False Then '是预览
     
183.                 Mistr = "": Mastr = ""
     
184.                 Mistr = Mip(0) & "," & Mip(1) & "," & Mip(2)
     
185.                 Mastr = Map(0) & "," & Map(1) & "," & Map(2)
     
186.                 Doc.SendCommand "zoom W" & Chr(13) & Mistr & Chr(13) & Mastr &
     
187. 
     
188. Chr(13)
     
189.             Else   '打印
     
190.                 Doc.Application.ZoomWindow Mip, Map
     
191.             End If
     
192.            Upp = Doc.Utility.TranslateCoordinates(Map, acWorld, acDisplayDCS,
     
193. 
     
194. False)
     
195.            Low = Doc.Utility.TranslateCoordinates(Mip, acWorld, acDisplayDCS,
     
196. 
     
197. False)
     
198.             ReDim Preserve Low(0 To 1)
     
199.             ReDim Preserve Upp(0 To 1)
     
200.             With Doc.ActiveLayout
     
201.                 .PlotRotation = Val(IIf(Pand(Mip, Map), 1, 0)) '设置横向竖向打印
     
202.                 .SetWindowToPlot Low, Upp
     
203.                 .PlotType = acWindow '窗口打印
     
204.             End With
     
205. '********************************************************************************
     
206. 
     
207. *******
     
208.          j = j + 1 '记录打印或者预览次数
     
209.          
     
210. '预览图形文件
     
211. '********************************************************************************
     
212. 
     
213. *******
     
214.           If Flag = False Then '预览
     
215.                Doc.Plot.DisplayPlotPreview acFullPreview '预览图形
     
216.                If SSt.Count > j Then '说明不是最后一张
     
217.                    Dim kwordList As String
     
218.                     kwordList = "Y N"
     
219.                     Doc.Utility.InitializeUserInput 0, kwordList
     
220.                     GTstr = Doc.Utility.GetKeyword("是否预览下一张？[是(Y)/否(N)]
     
221. 
     
222. <Y>")
     
223.                     If GTstr = "" Then GTstr = "Y"
     
224.                     If Err.Number = "-2147352567" Then GTstr = "N"
     
225.                End If
     
226.                If GTstr = "N" Then Exit For
     
227. '********************************************************************************
     
228. 
     
229. *******
     
230. 
     
231. '打印图形文件
     
232. '********************************************************************************
     
233. 
     
234. *******
     
235.           Else '打印
     
236.                 If Mainfrm.Frame5.Visible = True Then
     
237.                       Doc.Plot.PlotToDevice
     
238.                 ElseIf Mainfrm.Frame7.Visible = True Then
     
239.                       Doc.Plot.PlotToFile Mlstr2 & Filstr & ".pdf"
     
240.                       ShutDic Prodic
     
241.                 End If
     
242.                 Mainfrm.Label1 = Toustr & "打印进度：" & FormatPercent(Val(j /
     
243. 
     
244. SSt.Count), 2)
     
245.           End If
     
246.           DoEvents
     
247.        Next
     
248. '********************************************************************************
     
249. 
     
250. *******
     
251. 
     
252. 'U回图形原来的状态
     
253. '********************************************************************************
     
254. 
     
255. *******
     
256.        Doc.EndUndoMark
     
257.        Doc.SendCommand "U" & Chr(13)
     
258. '********************************************************************************
     
259. 
     
260. *******
     
261. End Sub
     
262. 
     

Public Sub Dy(SSt As AcadSelectionSet, Flag As Boolean, Optional Doc As <br /> <br /> AcadDocument, Optional Mlstr1 As String = "忽略", Optional Mlstr2 As String = "忽<br /> <br /> 略")<br />     Dim i As Integer, j As Integer<br />     Dim Ent As AcadEntity, Mtk As AcadBlockReference<br />     Dim GTstr As String, Plotstr As String<br />     Dim Low As Variant, Upp As Variant<br />     Dim Mastr As String, Mistr As String, Mip, Map<br />     Dim ACADLayout As ACADLayout<br />     Dim Toustr As String '显示进度条<br />     Dim Att As AcadAttribute<br />     Dim Mydic As Scripting.Dictionary '创建属性字典，以句柄为主键,以一个储存此Id<br /> <br /> 内属性的字典为item<br />     Dim Filstr As String '输出的文件名<br />     Dim Setoutlst As Variant, Setoutstr(1 To 1) As String<br />     Dim ATTstr As String<br />   'On Error Resume Next<br /> '在块没有改变前，以其句柄为key建立一个有关其属性的字典（因为所删非打印层也有属性<br /> <br /> ）<br /> '********************************************************************************<br /> <br /> *******<br />       Set Mydic = CreateObject("Scripting.Dictionary")<br />       If Mlstr1 <> "忽略" Then '说明此参数没有被忽略，再进行分图或者批打到文件<br />                For Each Mtk In SSt<br />                    ATTstr = ""<br />                    Atts = Mtk.GetAttributes<br />                       For i = 0 To UBound(Atts)<br />                             ATTstr = ATTstr & Atts(i).TagString & Chr(174) & <br /> <br /> Atts(i).TextString & vbLf<br />                       Next<br />                       ATTstr = ATTstr & "块名" & Chr(174) & Mtk.EffectiveName & <br /> <br /> vbLf<br />                       Mydic.Add Mtk.Handle, ATTstr<br />                Next<br />       End If<br /> '********************************************************************************<br /> <br /> *******<br /> <br />    Doc.StartUndoMark '设置U回点<br />    <br /> '删除块内非打印层并进行同步<br /> '********************************************************************************<br /> <br /> *******<br />                 For Each Ent In Doc.Blocks(Mainfrm.TextBox1.Text)<br />                      If Doc.Layers(Ent.Layer).Plottable = False Then<br />                         Ent.Delete<br />                      End If<br />                 Next<br />                 Doc.SendCommand "ATTSYNC N " & Mainfrm.TextBox1.Text & Chr(13)<br />                 Doc.Regen acActiveViewport<br />                 Doc.SetVariable "REGENMODE", 1 '防止图纸大的时候缩放出现提示<br />                 Doc.SetVariable "BACKGROUNDPLOT", 0 ' 确保<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>在前台进行打印，<br /> <br /> 这样后一次打印会在前一次打印完成之后才开始,避免出现错误<br />                 Doc.Application.ZoomExtents<br /> '********************************************************************************<br /> <br /> *******<br /> <br />             j = 0 '打印或者预览初始值<br />                Doc.ActiveLayout.CopyFrom Mpig '复制打印设置<br />                Doc.ActiveLayout.CenterPlot = True<br />                Doc.ActiveLayout.RefreshPlotDeviceInfo<br />                Doc.Regen acAllViewports<br /> '传递打印设置Mylayout到DOC.layouts("Model")<br /> '********************************************************************************<br /> <br /> *******<br />            'Debug.Print Doc.ActiveLayout.Name<br /> '            With Doc.ActiveLayout<br /> '                  .CenterPlot = True '居中打印<br /> '                  .ConfigName = Mylayout.ConfigName '打印机配置名称<br /> '                  .PaperUnits = Mylayout.PaperUnits '纸张单位<br /> '                  .PlotWithLineweights = Mylayout.PlotWithLineweights<br /> '                  .PlotWithPlotStyles = Mylayout.PlotWithPlotStyles<br /> '                  .ScaleLineweights = Mylayout.ScaleLineweights<br /> '                  .StyleSheet = Mylayout.StyleSheet<br /> '                  '.UseStandardScale = Mylayout.UseStandardScales<br /> '            End With<br /> '********************************************************************************<br /> <br /> *******<br /> <br /> '批量打印的时候需要设置<br /> '********************************************************************************<br /> <br /> *******<br /> '            If Flag = True Then<br /> '                Doc.Plot.QuietErrorMode = True<br /> '                Doc.Plot.StartBatchMode SSt.Count '调出批打模式<br /> '                Setoutstr(1) = "Model"<br /> '                Setoutlst = Setoutstr<br /> '                Doc.Plot.SetLayoutsToPlot Setoutlst<br /> '            End If<br /> '********************************************************************************<br /> <br /> *******<br /> <br />             Toustr = Mainfrm.Label1.Caption '记录进度标签内容<br />             <br /> 'SSt是一个图框图块的选择集，遍历此选择集，建立打印窗口<br /> '********************************************************************************<br /> <br /> *******<br />        For Each Mtk In SSt<br /> <br /> '批量打印的时候需要设置<br /> '********************************************************************************<br /> <br /> *******<br />             If Flag = True Then<br />                ' Doc.Plot.QuietErrorMode = True<br />                 Doc.Plot.StartBatchMode SSt.Count '调出批打模式<br />                 Setoutstr(1) = Doc.ActiveLayout.Name<br />                 Setoutlst = Setoutstr<br />                 Doc.Plot.SetLayoutsToPlot Setoutlst<br />             End If<br /> <br /> '********************************************************************************<br /> <br /> *******<br /> <br /> '打印pdf或者分图的时候需要传递此参数进行文件名字的设置<br /> '********************************************************************************<br /> <br /> *******<br />         If Mlstr1 <> "忽略" Then '说明此参数没有被忽略，再进行分图或者批打到文件<br />             Dim Marr, Mi As Integer, Ui As Integer, Ni As Integer<br />             Dim Mtemstr As String, Thisatt As New Scripting.Dictionary<br />               Filstr = Mlstr1<br />               Marr = Split(Mydic(Mtk.Handle), vbLf) '取出字符串 0开头<br />               Ui = UBound(Marr)<br />               For Mi = 0 To Ui - 1<br />                     Thisatt.Add Split(Marr(Mi), Chr(174))(0), Split(Marr(Mi), <br /> <br /> Chr(174))(1)<br />               Next<br />                For Mi = 0 To Ui - 1<br />     <br />                     For Ni = Mi + 1 To Ui - 1<br />                          If Len(Split(Marr(Ni), Chr(174))(0)) > Len(Split(Marr<br /> <br /> (Mi), Chr(174))(0)) Then<br />                                 Mtemstr = Marr(Mi)<br />                                 Marr(Mi) = Marr(Ni)<br />                                 Marr(Ni) = Mtemstr<br />                          End If<br />                        <br />                     Next<br />                     <br />               Next<br />               For Mi = 0 To Ui - 1<br />                   Filstr = Replace(Filstr, Split(Marr(Mi), Chr(174))(0), Thisatt<br /> <br /> (Split(Marr(Mi), Chr(174))(0)))<br />                   '此处会出现bug,比如前面一个Item后面一个key值一样<br />                   '则会使item变成后面一个key的item(以后再消除此bug)<br />               Next<br />               Thisatt.RemoveAll<br />               Set Thisatt = Nothing '清空字典<br />         End If<br /> '********************************************************************************<br /> <br /> *******<br /> <br /> '获得处理后的块box边界，设置窗口打印范围，并设置视口使打印或者预览范围可见<br /> '********************************************************************************<br /> <br /> *******<br />             Mtk.GetBoundingBox Mip, Map<br />             'Doc.ModelSpace.AddLine Mip, Map<br />             If Flag = False Then '是预览<br />                 Mistr = "": Mastr = ""<br />                 Mistr = Mip(0) & "," & Mip(1) & "," & Mip(2)<br />                 Mastr = Map(0) & "," & Map(1) & "," & Map(2)<br />                 Doc.SendCommand "zoom W" & Chr(13) & Mistr & Chr(13) & Mastr & <br /> <br /> Chr(13)<br />             Else   '打印<br />                 Doc.Application.ZoomWindow Mip, Map<br />             End If<br />            Upp = Doc.Utility.TranslateCoordinates(Map, acWorld, acDisplayDCS, <br /> <br /> False)<br />            Low = Doc.Utility.TranslateCoordinates(Mip, acWorld, acDisplayDCS, <br /> <br /> False)<br />             ReDim Preserve Low(0 To 1)<br />             ReDim Preserve Upp(0 To 1)<br />             With Doc.ActiveLayout<br />                 .PlotRotation = Val(IIf(Pand(Mip, Map), 1, 0)) '设置横向竖向打印<br />                 .SetWindowToPlot Low, Upp<br />                 .PlotType = acWindow '窗口打印<br />             End With<br /> '********************************************************************************<br /> <br /> *******<br />          j = j + 1 '记录打印或者预览次数<br />          <br /> '预览图形文件<br /> '********************************************************************************<br /> <br /> *******<br />           If Flag = False Then '预览<br />                Doc.Plot.DisplayPlotPreview acFullPreview '预览图形<br />                If SSt.Count > j Then '说明不是最后一张<br />                    Dim kwordList As String<br />                     kwordList = "Y N"<br />                     Doc.Utility.InitializeUserInput 0, kwordList<br />                     GTstr = Doc.Utility.GetKeyword("是否预览下一张？[是(Y)/否(N)] <br /> <br /> <Y>")<br />                     If GTstr = "" Then GTstr = "Y"<br />                     If Err.Number = "-2147352567" Then GTstr = "N"<br />                End If<br />                If GTstr = "N" Then Exit For<br /> '********************************************************************************<br /> <br /> *******<br /> <br /> '打印图形文件<br /> '********************************************************************************<br /> <br /> *******<br />           Else '打印<br />                 If Mainfrm.Frame5.Visible = True Then<br />                       Doc.Plot.PlotToDevice<br />                 ElseIf Mainfrm.Frame7.Visible = True Then<br />                       Doc.Plot.PlotToFile Mlstr2 & Filstr & ".pdf"<br />                       ShutDic Prodic<br />                 End If<br />                 Mainfrm.Label1 = Toustr & "打印进度：" & FormatPercent(Val(j / <br /> <br /> SSt.Count), 2)<br />           End If<br />           DoEvents<br />        Next<br /> '********************************************************************************<br /> <br /> *******<br /> <br /> 'U回图形原来的状态<br /> '********************************************************************************<br /> <br /> *******<br />        Doc.EndUndoMark<br />        Doc.SendCommand "U" & Chr(13)<br /> '********************************************************************************<br /> <br /> *******<br /> End Sub <br /> <br />

huaxiamengqing

这都沉到底了，我自己来顶置一下。

254619324

楼主很强大，佩服佩服，新手看不懂，希望好好向你学习，你发的帖子我几乎都看了

huaxiamengqing

254619324 发表于 2013-1-6 09:35
楼主很强大，佩服佩服，新手看不懂，希望好好向你学习，你发的帖子我几乎都看了

转.net了，看自己以前写的VBA代码，除了几个好的算法，简直就是一堆垃圾。