谁能提供将DWG批量转换成PLT格式的程序,最好提供VB代码!
<P>谁能提供将DWG批量转换成PLT文件的程序,最好提供VB代码!</P><P>有可以解答VB编程疑问的高手,请联系我.</P>
<P>QQ:34731786</P>
<P>Email: <A href="mailto:Jianyu416@sina.com" target="_blank" >Jianyu416@sina.com</A></P>
<P> 先谢了!</P> <P>Dim StartPoint As Variant, EndPoint As Variant<BR> Dim seta As AcadSelectionSet<BR> Dim dataTYPE(0 To 1) As Integer<BR> Dim dataValue(0 To 1) As Variant<BR> Dim aa As Integer<BR> Dim bb As String<BR> Dim Docname As String<BR> <BR> <BR> Dim docObj As AcadDocument<BR> Set aCADapp = GetObject(, "AutoCAD.Application.16")<BR> ' Set ThisDrawing = AcadApp.ActiveDocument</P>
<P> For aa = 0 To ListBox1.ListCount - 1</P>
<P> bb = ListBox1.List(aa)<BR> Docname = dirc & bb</P>
<P> Set ThisDrawing = aCADapp.Documents.Open(Docname)<BR> <BR> dataTYPE(0) = 2<BR> dataTYPE(1) = 8<BR> 'dataTYPE(2) = 8<BR> 'dataValue(0) = "AcDbBlockReference"<BR> dataValue(0) = "T*" '块参照的名称<BR> dataValue(1) = "BORDER" '图层名<BR> <BR> Set seta = ThisDrawing.SelectionSets.Add("Chen") '添加一选择集<BR> ZoomAll<BR> seta.Select acSelectionSetAll, , , dataTYPE, dataValue '过滤条件<BR> 'seta.SelectOnScreen dataTYPE, dataValue '在屏幕上选取过滤条件(图框)<BR> <BR> Dim bl As AcadBlockReference<BR> For i = 0 To seta.Count - 1<BR> <BR> 'MsgBox seta.Item(i).ObjectName<BR> seta.Highlight True<BR> If i = 0 Then<BR> <BR> Set bl = seta.Item(i)<BR> Else<BR> Set bl = seta.Item(i - 1)<BR> End If<BR> 'MsgBox bl.Name<BR> Next<BR> <BR> <BR> 'Dim oPlot As AcadPlot<BR> Dim AddedLayouts() As String<BR> Dim LayoutList As Variant<BR> Dim oLayout As AcadLayout<BR> Dim ArraySize As Integer, BatchCount As Integer<BR> <BR> For Each oLayout In ThisDrawing.Layouts<BR> ArraySize = ArraySize + 1<BR> ReDim Preserve AddedLayouts(1 To ArraySize)<BR> AddedLayouts(ArraySize) = oLayout.Name<BR> Next<BR> LayoutList = AddedLayouts<BR> <BR> bl.GetBoundingBox StartPoint, EndPoint '得到图框尺寸<BR> 'ThisDrawing.ActiveLayout.PlotType = acWindow<BR> ThisDrawing.ModelSpace.Layout.GetWindowToPlot StartPoint, EndPoint</P>
<P> <BR> '打印到文件<BR> Dim plotFileName As String<BR> Dim result As Boolean<BR> Dim currentPlot As AcadPlot<BR> Set currentPlot = ThisDrawing.Plot<BR> <BR> plotFileName = "c:\MyPlot\MyPlot" & aa & ".plt"<BR> 'currentPlot.SetLayoutsToPlot<BR> currentPlot.SetLayoutsToPlot LayoutList<BR> <BR> <BR> ' 验证活动空间是模型空间<BR> <BR> If ThisDrawing.ActiveSpace = acPaperSpace Then<BR> ThisDrawing.MSpace = True<BR> ThisDrawing.ActiveSpace = acModelSpace<BR> <BR> End If<BR> <BR> <BR> Dim ACADPref As AcadPreferencesOutput<BR> Dim originalValue As Boolean<BR> <BR> <BR> ' 设置打印区域的范围和比例<BR> <BR> ThisDrawing.ModelSpace.Layout.PlotType = acExtents<BR> ' ThisDrawing.ModelSpace.Layout.GetPaperSize 420, 297<BR> ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit<BR><BR> ' 设置打印区域的范围和比例<BR> ThisDrawing.ModelSpace.Layout.PlotType = acExtents<BR> ThisDrawing.ModelSpace.Layout.StandardScale = acScaleToFit<BR> <BR> ' 将打印份数设置为 1<BR> ThisDrawing.Plot.NumberOfCopies = 1<BR> <BR> ' 初始化打印<BR> Dim PlotConfigurations As AcadPlotConfigurations<BR> Dim PlotConfiguration As AcadPlotConfiguration<BR> Dim NewPC1 As AcadPlotConfiguration, NewPC2 As AcadPlotConfiguration<BR> <BR> ' Get PlotConfigurations collection from document object<BR> Set PlotConfigurations = ThisDrawing.PlotConfigurations<BR> <BR> ' Add NewPC1 and customize some of the properties<BR> Set NewPC1 = PlotConfigurations.Item(0)<BR> NewPC1.PlotRotation = ac270degrees<BR> NewPC1.PlotHidden = True<BR> NewPC1.PaperUnits = acMillimeters<BR> <BR> ' ThisDrawing.Plot.PlotToFile plotFileName, NewPC1<BR> <BR> ' This example will access the PlotConfigurations collection for the current drawing,<BR> ' add a plot configuration, and list basic information about the<BR> ' plot configurations in the drawing.<BR> <BR> Dim msg As String<BR> <BR> ' Get PlotConfigurations collection from document object<BR> Set PlotConfigurations = ThisDrawing.PlotConfigurations<BR> <BR> ' If there aren't any plot configurations, then add one<BR> If PlotConfigurations.Count = 0 Then<BR> '*** Customize the new configuration to your satisfaction ***<BR> PlotConfigurations.Add "NEW_CONFIGURATION"<BR> End If<BR> <BR> msg = vbCrLf & vbCrLf ' Start with a space<BR> <BR> ' Get the names of the plot configurations in this drawing<BR> For Each PlotConfiguration In PlotConfigurations<BR> msg = msg & PlotConfiguration.Name & vbCrLf<BR> Next<BR> <BR> ' Display a list of available plot configurations<BR> MsgBox "There are " & PlotConfigurations.Count & " plot configuration(s) in " & ThisDrawing.WindowTitle & ":" & msg<BR> <BR> '============================打印预览==========================<BR> <BR> ' This example creates a circle and then performs a plot preview.<BR> <BR> ' Create the circle<BR> Dim circleObj As AcadCircle<BR> Dim center(0 To 2) As Double<BR> Dim radius As Double<BR> center(0) = 2: center(1) = 2: center(2) = 0<BR> radius = 1<BR> Set circleObj = ThisDrawing.ModelSpace.AddCircle(center, radius)<BR> ZoomAll<BR> <BR> ' Preview the plot of the circle<BR> ' ThisDrawing.Plot.DisplayPlotPreview acFullPreview</P>
<P> <BR> ' ==========================打印到文件============================<BR> ' Define the output file name.<BR> ' Use "" to use the drawing name as the file name.<BR> <BR> <BR> result = currentPlot.PlotToFile(plotFileName)<BR> ' 初始化打印cbx<BR> 'ThisDrawing.Plot.PlotToDevice<BR> 'currentPlot.PlotToDevice '输出到当前打印设备<BR> seta.Delete '删除选择集<BR> <BR> ThisDrawing.Close '关闭当前文档<BR> 'ThisDrawing.Application.Documents.Close '关闭所有文档<BR> Next aa</P> 嗯 很好 正好需要 不过程序还可以更完善一些 奇怪的是这个贴子的日期怎么这么早
页:
[1]