cad批量打印
总结
初级经济法重点总结下载党员个人总结TXt高中句型全总结.doc高中句型全总结.doc理论力学知识点总结pdf
VBA
cad vb及批量打印
cad二次开发中VB或VBA的应用问题1、 如何在 VB 中连接 AutoCAD。启动 VB ,引用 AutoCAD 类型库。操作步骤:从“工程”菜单中选择“引用”选项,启动“引用”对话框。在“引用”对话框中,选择 AutoCAD 类型库,然后单击“确定”。2、 定义模块级变量 AutoCAD 应用程序 (acadApp) 和当前的文档 (acadDoc)。如果 AutoCAD 正在运行,使用 GetObject 函数将检索 AutoCAD Application 对象。如果 AutoCAD 没有运行,使用 CreateObject 函数试图创建一个 AutoCAD Application 对象。如果创建成功,会启动 AutoCAD;如果失败,则会发生错误。 同时运行多个 AutoCAD 任务时,GetObject 函数会返回 Windows 运行对象
表
关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf
中的第一个 AutoCAD 实例。要显示 AutoCAD 图形窗口,需要将 AutoCAD 应用程序的 Visible 特性设置为 TRUE。 使用 acadDoc 变量引用当前的 AutoCAD 图形。 示例: Dim acadApp As AcadApplicationDim acadDoc as AcadDocument Sub ConnectToAcad()On
Error Resume NextSet acadApp = GetObject(, "AutoCAD.Application")If Err
ThenErr.ClearSet acadApp = CreateObject("AutoCAD.Application")If Err Then EndEnd
IfacadApp.Visible = TrueSet acadDoc = acadApp.ActiveDocumentEnd Sub2、如何使 VB 开发的程序不依赖于 AutoCAD 的版本。启动 VB ,定义模块级变量 AutoCAD 应用程序 (acadApp) 和当前的文档 (acadDoc)。如果 AutoCAD 正在运行,使用 GetObject 函数将检索 AutoCAD Application 对象。如果 AutoCAD 没有运行,使用 CreateObject 函数试图创建一个 AutoCAD Application 对象。如果创建成功,会启动 AutoCAD;如果失败,则会发生错误。 同时运行多个 AutoCAD 任务时,GetObject 函数会返回 Windows 运行对象表中的第一个 AutoCAD 实例。要显示 AutoCAD 图形窗口,需要将 AutoCAD 应用程序的 Visible 特性设置为 TRUE。 使用 acadDoc 变量引用当前的 AutoCAD 图形。 示例: Dim acadApp As ObjectDim acadDoc as Object Sub ConnectToAcad()On Error Resume NextSet
acadApp = GetObject(, "AutoCAD.Application")If Err ThenErr.ClearSet acadApp =
CreateObject("AutoCAD.Application")If Err Then EndEnd IfacadApp.Visible = TrueSet
acadDoc = acadApp.ActiveDocumentEnd Sub与第一个问题相比较,可以看出,不引用具体的类型库以及使用通用的对象类型就可以达到通用性。3、前期绑定和后期绑定要创建一个使用前期绑定方式的对象变量,也就是说,在程序编译时就完成绑定,则对象变量在声明时应指定类 ID,如:Dim acadApp As AcadApplication。使用 As Object 子句声明对象变量,可以创建一个能包含任何类型对象引用的变量。不过,该变量访问对象是后期绑定的,也就是说,绑定在程序运行时才进行,如:Dim acadApp As Object。前期绑定的变量引用可以提供更好的性能,但该变量只能存放声明中所指定的类的引用。而后期绑定的变量引用可以提供更好的通用性。4、依赖于版本和独立于版本如果 CreateObject 或 GetObject 函数使用的 ProgID 没有附加版本号,那么是独立于版本的,否则是依赖于版本的。例如,如果使用的是 CreateObject,则 CreateObject ("AutoCAD.Application") 是独立于版本的,而 CreateObject ("AutoCAD.Application.15") 是依赖于版本的。5、VB 代码到 VBA 代码的转换在 VBA 的 IDE 环境中,使用“导入文件”将要转换的 VB 工程的模块、类模块以及窗体文件一一导入。接着将 VB 代码中所有的当前的文档 (acadDoc) 变量替换为 ThisDrawing,而AutoCAD 应用程序 (acadApp) 变量替换为 Application。同时删除定义的 AutoCAD 应用程序 (acadApp) 和当前的文档 (acadDoc) 变量,删除与 AutoCAD 应用程序连接的代码。注意:要转换 VB 代码的窗体部分,则窗体必须是用 UserForm 创建的。6、图形对象和非图形对象图形对象(也称为图元、实体对象)是组成图形的可见对象(例如直线、圆、光栅图像等)。非图形对象是指属于图形的一部分但不可见的(提示性的)对象,例如 Layers、 Linetypes、 DimStyles、 SelectionSets 等等。要创建这些对象,可使用 Add
方法。每一个对象都有用于特定目的的方法和特性,都有设置和检索扩展数据以及删除自己的方法PLT方式打印Autocad图纸2008-04-15 22:56使用plt文件打印,打印服务器端使用Dos命令,服务器上不必安装cad,避免了不同电脑上cad版本不兼容以及字体、形文件不一致所造成的各种问题,并 且可以大大降低打印人员的工作强度,非常适合于大批量打印图纸。另外就是plt文件很难反编译,即便是反编译以后,图纸也已面目全非,在一定程度上保护了 图纸内容。其过程主要有两步:发布与打印.1:发布为PLT文件。在Autocad打印对话框中,选择好打印机后,我们会看到下面会有“打印到文件的可选项”,勾选它。然后再打印,指定文件的保存位置即可。2:打印PLT文件 。为方便说明,我们假设打印机名为lpt1.在MS-DOS窗口下用:copy *.plt lpt1 。同时,为方便,我们作一个批处理命令。 打开记事本,此文件里写入:copy *.plt lpt1 存为一个BAT格式的文件,以后需要打印,只要双击该BAT文件即就行了。
下面的是VBA代码,不知道C#怎么用
Public Sub PlotWindow()
' 确保当前布局是模型空间
ThisDrawing.ActiveLayout = ThisDrawing.Layouts.Item("Model")
' 设置打印设备
ThisDrawing.ActiveLayout.ConfigName = "DWF6 ePlot.pc3"
' 设置打印比例为"布满图纸"
ThisDrawing.ActiveLayout.StandardScale = acScaleToFit
' 设置图纸类型
ThisDrawing.ActiveLayout.CanonicalMediaName = "ISO_A4_(210.00_x_297.00_MM)"
' 让AutoCAD在前台进行打印
ThisDrawing.SetVariable "BACKGROUNDPLOT", 0
Dim objPlot As AcadPlot
Set objPlot = ThisDrawing.Plot
' 设置打印窗口
Dim minPoint(0 To 1) As Double, maxPoint(0 To 1) As Double
SetPoint2d minPoint, 0, 0
SetPoint2d maxPoint, 800, 600
ThisDrawing.ActiveLayout.SetWindowToPlot minPoint, maxPoint
' 设置打印类型
ThisDrawing.ActiveLayout.PlotType = acWindow
objPlot.PlotToFile "C:\test.dwf"
' 恢复系统变量的值
ThisDrawing.SetVariable "BACKGROUNDPLOT", 2
End Sub
Option Explicit '某文件夹下的包括下一级文件夹内的某个文件的筛选 Dim swApp As SldWorks.SldWorks Dim swPart As SldWorks.ModelDoc2 Dim swDraw As SldWorks.DrawingDoc Dim ps As SldWorks.PageSetup Dim longstatus As Long, longwarnings As Long '定义存储错误与警告 Dim Fname(50) As String '定义文件夹数组,用来存放文件夹名称 Dim Filename(50) As String '定义文件数组,用来存放文件名称 Dim Filepath(50) As String '存放文件地址名称
Dim i As Single, n As Single, ii As Single
Dim Objshell As Object
Dim Objfolder As Object
Private Sub Command1_Click() Dim Objshell As Object
Dim Objfolder As Object
Set Objshell = CreateObject("shell.application") '定义shell对象 属于shell32
Objfolder = Objshell.browseforfolder(0, "选择文件夹", 0, 0) '选择Set
打开的文件夹,返回folder对象
If Not Objfolder Is Nothing Then
If Objfolder.self.Type = "文件夹" Then
Text1.Text = Objfolder.self.path '提取Objfolder对象的文件地址
Else
MsgBox "选择不正确,请重新选择~", vbExclamation, "提示"
End If
End If
End Sub
Private Sub Command2_Click() On Error Resume Next
Dim nn As Single, path As String, wjhz As String, PrintName As String
, m As Single
Set swApp = GetObject(, "sldworks.application") If Err.Number <> 0
Then Set swApp = CreateObject("sldworks.application"): Err.Clear '定义sldworks对象
path = Text1.Text '提取文件地址
If Text1.Text = "" Then MsgBox "请选择打印文件夹路", vbInformation, "
提示": Exit Sub
wjhz = "SLDDRW"
Call test(path, wjhz)
If Filename(0) = "" Then MsgBox "没有可打印的工程图纸", vbCritical, "
错误提示": Exit Sub
If Option1.Value = False And Option2.Value = False Then MsgBox "请选择一个打印机": Exit Sub
If Option1.Value = True Then PrintName = Option1.Caption
If Option2.Value = True Then PrintName = Option2.Caption
Label2.Caption = "打印准备中...请稍后..."
swApp.Visible = False
For nn = 0 To ii - 1 'nn从0开始到ii-1次循环
Set swPart = swApp.OpenDoc6(Filepath(nn), 3, 0, "", longstatus, l
ongwarnings)
swPart.Printer = PrintName
Set ps = swPart.PageSetup
ps.Orientation = 2 ' 1=图片 '2 = 图形
Debug.Print ps.PrinterPaperSize
Dim PageArray(0) As Long
PageArray(0) = 0 '数字为0代表全部打印,一般为pageArray(3)代表4
-1,2-2,代表打印1和2具体参见API 个数值,两两一对,例如1
Dim vPageArray As Variant
vPageArray = PageArray
"", "" '参数3为空 swPart.Extension.PrintOut2 vPageArray, 1, True,
代表默认打印机,参见API
Label2.Caption = "已打印" & Filename(nn)
swApp.CloseDoc Filename(nn) '管板当前图纸
Set swPart = Nothing
Next
Label2.Caption = "打印已完成"
Text1.Text = ""
MsgBox "打印已完成,共打印" & nn & "张图纸"
swApp.Visible = True
' swApp.ExitApp
Set swApp = Nothing
End Sub
Private Sub test(Folderpath As String, wjhz As String) Dim fso As Object, fn As Object, fi As Object, fn1 As Object, fi1 As
Object, fi2 As Object
Dim ofso As Object
On Error Resume Next
Set fso = CreateObject("scripting.filesystemobject")
= fso.getfolder(Folderpath) '定义ofso为某地址下的文件对象 Set ofso
Set fn = ofso.subfolders '定义fn为ofso文件对象下的文件夹集合
Set fi = ofso.Files '定义fi为ofso文件对象下的文件集合
i = 0: n = 0: ii = 0 '清零
If fn.Count > 0 Then
For Each fn1 In fn '在文件夹集合中循环
Fname(i) = fn1.Name '将文件夹名称写入数组
For Each fi1 In fso.getfolder(Folderpath & "\" & fn1.Name
).Files '在当前文件夹内的文件集合中循环
If InStr(fi1.Name, UCase(wjhz)) > 0 Or InStr(fi1.Name
, LCase(wjhz)) > 0 Then '如果文件名称含有DWG或dwg字符为true
Filename(n) = fi1.Name '将满足要求的文件名称写入数组
Filepath(ii) = fi1.path '将地址保存
n = n + 1
ii = ii + 1
End If
DoEvents '将程序交给系统
Next
i = i + 1
DoEvents '将程序交给系统
Next
End If
For Each fi2 In fi
If InStr(fi2.Name, UCase(wjhz)) > 0 Or InStr(fi2.Name, LCase(
wjhz)) > 0 Then '如果文件名称含有DWG或dwg字符为true
Filename(n) = fi2.Name '将满足要求的文件名称写入数组
Filepath(ii) = fi2.path '将地址保存
n = n + 1
ii = ii + 1
End If
DoEvents '将程序交给系统
Next
Sub End
Private Sub Form_Load()
Label2.Caption = "打印就绪"
End Sub
VB实现打开指定的CAD文件
Public Function opencad(cadfilepathd As String, cadname As String) '打开cad过程
Dim acadapp As AcadApplication Dim acaddoc As AcadDocument Dim ts As String
Dim tsmsg As String
On Error Resume Next
Set acadapp = GetObject(, "AutoCAD.Application") '检测cad是否打开 If Err.Number = 429 Then 'cad如果没有打开
Error.Clear
If Dir(cadfilepathd) <> "" Then '检测文件是否存在
Set acadapp = GetObject("", "AutoCAD.Application") '打开cad
acadapp.Visible = True 'cad可见
acadapp.Documents.Open cadfilepathd '打开相应文件
Else
tsmsg = "没有找到" & cadname & ".dwg"
ts = MsgBox(tsmsg, vbOKOnly, "错误!")
End If
ElseIf Err.Number = 0 Then '如果cad打开
Error.Clear
If Dir(cadfilepathd) <> "" Then '检测文件是否存在
acadapp.Documents.Open cadfilepathd '打开相应文件
acadapp.Visible = True
Else
tsmsg = "没有找到" & cadname & ".dwg"
ts = MsgBox(tsmsg, vbOKOnly, "错误!")
End If
Else
ts = MsgBox("软件内部错误,请联系作者~", vbOKOnly, "错误~") '如果出现其他错误代码,软件本身出错
End
End If
End Function
VB调用API设置当前打印机、显示默认打印机 1. VisualBasic 中启动新标准 EXE 工程。 默认情况下创建 Form 1。 2. 向项目添加一个新模块并插入以下代码:
Public Const HWND_BROADCAST = &HFFFF Public Const WM_WININICHANGE = &H1A
' constants for DEVMODE structure Public Const CCHDEVICENAME = 32 Public Const CCHFORMNAME = 32
' constants for DesiredAccess member of PRINTER_DEFAULTS
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000 Public Const PRINTER_ACCESS_ADMINISTER = &H4 Public Const PRINTER_ACCESS_USE = &H8 Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
' constant that goes into PRINTER_INFO_5 Attributes member
' to set it as default
Public Const PRINTER_ATTRIBUTE_DEFAULT = 4
' Constant for OSVERSIONINFO.dwPlatformId Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128 End Type
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' // Windows 95 only
dmICMIntent As Long ' // Windows 95 only
dmMediaType As Long ' // Windows 95 only
dmDitherType As Long ' // Windows 95 only
dmReserved1 As Long ' // Windows 95 only
dmReserved2 As Long ' // Windows 95 only End Type
Public Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type
Public Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Declare Function GetProfileString Lib "kernel32" _ Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Declare Function WriteProfileString Lib "kernel32" _ Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long
Declare Function SendMessage Lib "user32" _ Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lparam As String) As Long
Declare Function GetVersionExA Lib "kernel32" _ (lpVersionInformation As OSVERSIONINFO) As Integer
Public Declare Function OpenPrinter Lib "winspool.drv" _ Alias "OpenPrinterA" _
(ByVal pPrinterName As String, _
phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function SetPrinter Lib "winspool.drv" _ Alias "SetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal Command As Long) As Long
Public Declare Function GetPrinter Lib "winspool.drv" _ Alias "GetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal cbBuf As Long, _
pcbNeeded As Long) As Long
Public Declare Function lstrcpy Lib "kernel32" _ Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As Any) As Long
Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Public Sub SelectPrinter(NewPrinter As String)
Dim Prt As Printer
For Each Prt In Printers
If Prt.DeviceName = NewPrinter Then
Set Printer = Prt
Exit For
End If
Next
End Sub
3. Form 1 上放置一个 CommandButton 和 ListBox。
4. 以下代码添加到 Form 1 的 GeneralDeclarations 部分:
Option Explicit
Private Function PtrCtoVbString(Add As Long) As String
Dim sTemp As String * 512, x As Long
x = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
PtrCtoVbString = ""
Else
PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function
Private Sub SetDefaultPrinter(ByVal PrinterName As String, _
ByVal DriverName As String, ByVal PrinterPort As String)
Dim DeviceLine As String
Dim r As Long
Dim l As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
' Store the new printer information in the [WINDOWS] section of
' the WIN.INI file for the DEVICE= item
r = WriteProfileString("windows", "Device", DeviceLine)
' Cause all applications to reload the INI file:
l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows") End Sub
Private Sub Win95SetDefaultPrinter()
Dim Handle As Long 'handle to printer
Dim PrinterName As String
Dim pd As PRINTER_DEFAULTS
Dim x As Long
Dim need As Long ' bytes needed
Dim pi5 As PRINTER_INFO_5 ' your PRINTER_INFO structure
Dim LastError As Long
' determine which printer was selected
PrinterName = List1.List(List1.ListIndex)
' none - exit
If PrinterName = "" Then
Exit Sub
End If
' set the PRINTER_DEFAULTS members
pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
' Get a handle to the printer
x = OpenPrinter(PrinterName, Handle, pd)
' failed the open
If x = False Then
'error handler code goes here
Exit Sub
End If
' Make an initial call to GetPrinter, requesting Level 5
' (PRINTER_INFO_5) information, to determine how many bytes
' you need
x = GetPrinter(Handle, 5, ByVal 0&, 0, need)
' don't want to check Err.LastDllError here - it's supposed
' to fail
' with a 122 - ERROR_INSUFFICIENT_BUFFER
' redim t as large as you need
ReDim t((need \ 4)) As Long
' and call GetPrinter for keepers this time
x = GetPrinter(Handle, 5, t(0), need, need)
' failed the GetPrinter
If x = False Then
'error handler code goes here
Exit Sub
End If
' set the members of the pi5 structure for use with SetPrinter.
' PtrCtoVbString copies the memory pointed at by the two string
' pointers contained in the t() array into a Visual Basic string.
' The other three elements are just DWORDS (long integers) and
' don't require any conversion
pi5.pPrinterName = PtrCtoVbString(t(0))
pi5.pPortName = PtrCtoVbString(t(1))
pi5.Attributes = t(2)
pi5.DeviceNotSelectedTimeout = t(3)
pi5.TransmissionRetryTimeout = t(4)
' this is the critical flag that makes it the default printer
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
' call SetPrinter to set it
x = SetPrinter(Handle, 5, pi5, 0)
If x = False Then ' SetPrinter failed
MsgBox "SetPrinter Failed. Error code: " & Err.LastDllError
Exit Sub
Else
If Printer.DeviceName <> List1.Text Then
' Make sure Printer object is set to the new printer
SelectPrinter (List1.Text)
End If
End If
' and close the handle
ClosePrinter (Handle)
End Sub
Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As _
String, PrinterPort As String)
Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = ""
' The driver name is first in the string terminated by a comma
iDriver = InStr(Buffer, ",")
If iDriver > 0 Then
' Strip out the driver name
DriverName = Left(Buffer, iDriver - 1)
' The port name is the second entry after the driver name
' separated by commas.
iPort = InStr(iDriver + 1, Buffer, ",")
If iPort > 0 Then
' Strip out the port name
PrinterPort = Mid(Buffer, iDriver + 1, _
iPort - iDriver - 1)
End If
End If
End Sub
Private Sub ParseList(lstCtl As Control, ByVal Buffer As String)
Dim i As Integer
Dim s As String
Do
i = InStr(Buffer, Chr(0))
If i > 0 Then
s = Left(Buffer, i - 1)
If Len(Trim(s)) Then lstCtl.AddItem s
Buffer = Mid(Buffer, i + 1)
Else
If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer
Buffer = ""
End If
Loop While i > 0
End Sub
Private Sub WinNTSetDefaultPrinter()
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim PrinterName As String
Dim r As Long
If List1.ListIndex > -1 Then
' Get the printer information for the currently selected
' printer in the list. The information is taken from the
' WIN.INI file.
Buffer = Space(1024)
PrinterName = List1.Text
r = GetProfileString("PrinterPorts", PrinterName, "", _
Buffer, Len(Buffer))
' Parse the driver name and port name out of the buffer
GetDriverAndPort Buffer, DriverName, PrinterPort
If DriverName <> "" And PrinterPort <> "" Then
SetDefaultPrinter List1.Text, DriverName, PrinterPort
If Printer.DeviceName <> List1.Text Then
' Make sure Printer object is set to the new printer
SelectPrinter (List1.Text)
End If
End If
End If
End Sub
Private Sub Command1_Click()
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
Call Win95SetDefaultPrinter
Else
' This assumes that future versions of Windows use the NT method
Call WinNTSetDefaultPrinter
End If
End Sub
Private Sub Form_Load()
Dim r As Long
Dim Buffer As String
' Get the list of available printers from WIN.INI
Buffer = Space(8192)
r = GetProfileString("PrinterPorts", vbNullString, "", _
Buffer, Len(Buffer))
' Display the list of printer in the ListBox List1
ParseList List1, Buffer
End Sub
Public Function SetPrinterName(PrinterName As String) As String
Dim aName As String * 128
Dim aPrn As Printer
Dim aLen As Long, aPos As Integer, aRc As Long, aDevStr As String
SetPrinterName = ""
aLen = GetProfileString("windows", "device", ByVal "", aName, 128)
If aLen > 0 Then
aPos = InStrB(1, aName, ",")
SetPrinterName = MidB(aName, 1, aPos - 1) '変更する前のプリンタ名
End If
'通常使うプリンタを
に書き込む。
For Each aPrn In Printers
If aPrn.DeviceName = PrinterName Then
aDevStr = aPrn.DeviceName & "," & aPrn.DriverName & "," & aPrn.Port
aRc = WriteProfileString("windows", "device", ByVal aDevStr)
Exit For
End If
Next
End Function
2)设置CrystalReport 的打印机属性来实现
'?2008/11/11 Add By DSS.Gao*************************
'通常使うプリンタをに書き込む。
For Each aPrn In Printers
If aPrn.DeviceName = aPrintNm Then
gDefDriver = aPrn.DriverName
gDefPort = aPrn.Port
Exit For
End If
Next