用VB在AutoCADR14中写TEXT的方法

 AutoCAD 可以写不同高宽比、不同角度、不同颜色的 TEXT。无论是用 AutoCAD

的 TEXT 命令，还是用 AutoLISP，都是很容易做到的，用 VB 是否也很容易哪？我们

来看下面一段示例：

Public objAcad As Object

Public objDoc As Object

Dim ent As Object

Dim startPoint(0 To 2) As Double

Dim Point1(0 To 2) As Double

Set objAcad = GetObject(, "AutoCAD.Application")    ' 获得AutoCAD R14对象

Set objDoc = objAcad.ActiveDocument

' 初始化 TEXT 的起点

startPoint(0) = 10#

startPoint(1) = 10#

startPoint(2) = 0#

' 写一串 TEXT, 其中字高为 5

Set ent = objDoc.ModelSpace.AddText("textString", startPoint, 5#)

' 初始化 TEXT 的调整点

Point1(0) = 20#

Point1(1) = 10#

Point1(2) = 0#

With ent

 .Color = 1                   ' 改用红色

 .ObliqueAngle = 0.174444     ' 改倾斜角度

  .VerticalAlignment = 0       ' 设垂直位置为 0

 .ScaleFactor = 1#            ' 设文字高宽比，当需要两端对齐时，必须任意给一个值

 .HorizontalAlignment = 5     ' 设文字为两端对齐

 .TextAlignmentPoint = Point1 ' 设对齐点

End With

Set objAcad = Nothing

a VB应用程序中用DDE功能开发AutoCAD for Windows

目前，许多工程CAD系统是以AutoCAD作为支撑软件，在其基础上进行二次开发而形成的。AutoCAD R12 for Windows 以AutoLISP和ADS作为二次开发工具，但它们都有不足之处，AutoLISP速度慢，没有友好的开发环境，ADS是基于C语言的开发环境，而C语言面向Windows编程本身难以掌握，因此AutoLISP和ADS的使用都受到一定的限制。VB是Windows下主要的开发工具之一，它的“可视性”和“事件驱动性”简化了面向Windows的编程，深受广大用户的青睐。Windows下，VB和AutoCAD都支持强有力的DDE(动态数据交换)功能，用VB编写具有DDE功能的程序来控制AutoCAD，既能与AutoCAD交换各种复杂的数据结构，又能向AutoCAD发送命令，由此开发出的应用程序能满足用户的需要，同时又缩短了开发周期。本文结合实例介绍了用VB开发AutoCAD的途径与方法。

一、直接利用DDE功能开发

　　DDE是Windows的强大功能之一，它可以使应用程序自动地接收由其它应用程序发送来的数据，当传送端的数据有变化时，接收端的数据也会随之改变，也可将命令或键盘输入传递给其它程序，实现远程控制。

　　在VB编程环境中，创建应用程序的方法很简单，首先是设计用户界面，也就是在空白窗体中放入所需要的控件，如命令按钮，单选钮，文本框，标签，图片框等，然后针对各控件上要发生的事件(如鼠标单击，鼠标移动等)书写事件过程，最后将编写的应用程序运行，调试，生成执行文件即可。VB中能和其它Window应用程序建立DDE通道的控件有文本框，标签和图片框。下面结合简单实例，说明VB应用程序与AutoCAD间建立DDE通道和交换数据的方法。

　　在VB中启动一个新项目，参见图(1)建立窗体，其中“建立链接”，“直线”，“标注”，“退出”为命令按钮，标有“Text1”的为文本框，用于建立DDE通道，并输入下面的事件代码。

　Option Explicit

　Private Sub cmdLine_Click() '画直线

　　Text1.LinkExecute " [^3^3line 3,3 8,8 ^3]"

　End Sub

　Private Sub cmdText_Click() '标注文字

　　Text1.LinkExecute " [^3^3text 10,10 1 90 AUTOCAD!^10]"

　End Sub

　Private Sub cmdLink_click() '建立链接

　　Text1.LinkMode = 0

　　Text1.LinkTopic = "autocad.dde|system"

　　Text1.LinkMode = 2

　End Sub

　Private Sub cmdExit_click() '退出

　　End

　End Sub

　　运行此应用程序，注意在运行前，一定要先加载AutoCAD。单击“建立链接”按扭，cmdLink_Click()过程被执行，执行时设置文本框Text1的LinkTopic和LinkMode的属性，完成VB应用程序与AutoCAD间DDE通道的建立。LinkTopic属性用于通知AutoCAD由谁来提供数据，它被管道符“|”分成两部分，第一部分“AutoCAD.DDE”为应用程序名，第二部分“System”是通讯的主题。LinkMode属性用于切实建立链接，在LinkMode=0时，表示关闭以前的DDE通道，在LinkMode=2时，表示以手动模式激活DDE通道。

　　在完成DDE链接后，VB应用程序就可以与AutoCAD间进行数据交换或命令传送了。单击“直线”按扭，cmdLine_Click()过程被执行，应用程序通过LinkExecute方法向AutoCAD发送命令，在AutoCAD中以点(3,3)和(8,8)为端心，画一条直线。语句中的^3相当于AutoCAD中的取消键Ctrl+C，空格相当于AutoCAD中的回车键。单击“标注”按扭，执行cmdText_Click()过程，可在AutoCAD中显示以(10,10)为基点，高为1，旋转角度为90的字符串“AutoCAD!”。语句中的^10相当于AutoCAD中的回车键，在标注文字时不能用空格代替回车键。

　　根据需要，可用上面的方法传送AutoCAD的其它命令，实现对AutoCAD的开发。

二、通过调用VB ADS开发

　　上面介绍了在VB应用程序中直接利用DDE与AutoCAD作用实现开发的方法，此方法要求用户自己建立与AutoCAD间的DDE通道，此外，我们还可以通过调用VB ADS函数对AutoCAD进行开发。在VB ADS函数库中已有专门的函数负责建立应用程序与AutoCAD间的DDE通道，而不需用户亲自建立，较为方便。另外，VB应用程序还可以通过VB ADS函数向AutoCAD发送数据和命令，同时也可以利用VB ADS函数的返回值来获得AutoCAD的数据，实现对AutoCAD更深入的开发。

　　为了利用AutoCAD的VB ADS函数建立VB的应用程序，AutoCAD提供了几个VB ADS支撑文件，这些文件除DDEBAS.EXE和ACADVB.DLL存放在C:\ACADWIN子目录外，其余都存放在C:\ACADWIN\VB\NEW子目录中。文件如下:

　　1. DDEBAS.EXE-ADS/DDE服务者，为保证VB于AutoCAD 间正常通信，此命令必须首先在AutoCAD中用XLOAD命令加载运行。

　　2. ACADVB.DLL-VB ADS动态连接库，在运行VB应用程序前，应将其拷到C:\WINDOWS\SYSTEM\子目录下。

　　3. GLOBAL.BAS-VB ADS应用程序中所需要使用的全局变量定义文件。

　　4. ADSFUNCS.BAS-VB ADS函数库，可以在VB应用程序中直接调用。

　　5. ADSFUNCS.FRM-包含有应用程序和AutoCAD间建立DDE链接的窗体文件。 下面结合具体的例子，说明利用VB ADS函数开发应用程序的方法。 [HJ] 　 　　启动VB，打开C:\ACADWIN\VB\NEW\NEWPROJ.MAK项目文件，参见图 [2]建立新窗体，并输入如下的事件代码。

　Option Explicit

　Private Sub Form_Load()

　　DDE_TIMEOUT = -1 　'等待DDE事件

　　txtX.Text = 5 　'圆心，半径的隐含值

　　txtY.Text = 5

　　txtRadius = 3

　End Sub

　Private Sub cmdCircle_Click() 　'画圆过程

　　Dim ret As Integer

　　Dim pt As ads_point 　'定义Ads点类型

　　Dim Radius As Double

　　Dim Apndll As ApndLLType 　'定义增加链表类型

　　Dim Resbuf As ResbufType 　'定义结果缓冲器

　　pt.X = val(Trim(txtX.Text))　'给圆心，半径赋值

　　pt.Y = val(Trim(txtY.Text))

　　 Radius = val(Trim(txtRadius.Text))

　　ret% = ads_newrb(10, Resbuf)　'建立新的结果缓冲器

　　Resbuf.hResbuf = 0

　　Apndll.apType = RTSTR　'说明链表类型为字符串

　　Apndll.apString = "circle" + Chr$(0)　'链表赋值

　　ret% = ApndLLNode(Resbuf, Apndll) 　'增加链表到结果缓冲器

　　Apndll.apType = RTPOINT

　　Apndll.apPoint = pt

　　ret% = ApndLLNode(Resbuf, Apndll)

　　Apndll.apType = RTREAL

　　Apndll.apReal = Radius

　　ret% = ApndLLNode(Resbuf, Apndll)

　　Apndll.apType = RTNONE 　 '链表结束值类型

　　ret% = ApndLLNode(Resbuf, Apndll)

　　ret% = ads_cmd(Resbuf) 　 '执行结果缓冲器的命令

　　ret% = ads_relrb(Resbuf) 　 '释放结果缓冲器

　　End Sub

Private Sub cmdExit_Click() 　 '退出过程

　　End

　End Sub

　　在应用程序运行前，必须首先运行AutoCAD，并用命令(XLOAD "DDEBAS")加载DDEBAS. EXE。在上面的应用程序中，除语句DDE_TimeOut＝-1外，没有其它涉及建立DDE通道的语句，因为应用程序与AutoCAD间建立DDE通道所需要的代码已保存在VB ADS 函数库中，打开支撑文件adsfuncs.bas，可以发现Sub OPENDDE()过程，它负责VB应用程序与AutoCAD间DDE通道的建立，所以用户在开发应用程序时，只管调用VB ADS函数即可。例子中的cmdCircle_Click()过程，是在VB 4.0编程环境通过调用VB ADS函数开发的，运行程序后在文本框中输入半径和圆心的值，单击“画图”按扭，即可在AutoCAD中得到所需的圆。

c VB应用程序编制实例

    VB自1991年问世以来，已从1.0版步入到功能十分强大的5.0版。VB以其开发软件周期短、操作简单、可视化程度高的优点倍受编程人员的青睐。近几年来，许多Windows程序员应用VB作为编程语言，开发了大量的应用软件。本文通过几个实例说明了VB的强大功能。

一、工具棒的建立方法

    Windows应用程序的操作界面都含有大量的图标，这些图标集中放在某一个区域形成工具棒(Toolbars), 工具棒中的图标用图示的方法表示某一种功能，可以加速操作，在某些Windows应用程序中还把这些工具棒直接称为加速棒（Speedbars）。下面介绍编制工具棒的方法。

    在窗体上画一个足够大的图片框，使用这个图片框可以存放图标。设置图片框的Align属性，使图片框列在窗口的顶部，即[窗体名][控件名]Align=1.

    在图片框中增加影像控件(Image Control)数组或者三维命令控制按钮数组(3D Command Button Control)。改变控件的Picture属性，输入图形，图形的格式为：*.BMP,*.DIB,*.WMF,*.ICO。

    下面的实例介绍了工具棒的建立方法，具体步骤为：

    1．建立一个图片框，取名为Demo(即Name属性为Demo)，设置Align属性，即 Demo.Align=1

    2．在图片框上增加三维命令按钮，设置Name属性为Tool，设置Index的属性为0(第一个控件)，改变 Picture 属性，输入图示化的图形(文件)。改变提示信息，设置Caption取值为空。

    3．增加三维命令按钮控件，设置Name属性为Tool，注意使Index属性分别为1，2，……。

    4．建立窗体Paint事件过程

Sub FormPaint()

Demo.ScaleHeight = Tool(0).Height '设置工具棒的高度

iw％ = Tool(0).Width '获取第一个图标的宽度，用于设置其他的图标宽度

For i％ = 0 To 3

Tool(i％).Height = Demo.Scaleheiht

Tool(i％).Width = iw％

Tool(i％).AutoSize = 1 '设置图标中的图形充满整个图形框

Tool(i％).Move iw％ ＊ i％, 0 '重新排列所有图标的位置

Next i％

End Sub

    5.建立图标事件过程

    为工具棒中的每一个图标增加一个过程，执行相应的命令：

Sub Tool_Click(index As Integer)

If index = 0 Then

Tool (0). Picture = Load(″animal.bmp″) '更换第一个图标中图像

ElseIf index = 1 Then

j％ = Shell(″calc.exe″, 1) '执行WINDOWS95计算重新CALC.EXE

ElseIf index = 2 Then End '中止程序的执行

End If

End Sub

在实际应用中，程序员可以发挥自己的想象力，从而完善工具棒的功能。

AutoCAD中表格自动化

　　工程图纸中经常遇到大量表格填写，例如工程勘察中的成果表、设计的材料表，在AutoCAD中文字处理比较差，用TEXT、DTEXT命令在表格中定位也不方便，填写的表格既不美观，还容易出错。在一些杂志中有关表格填写程序介绍，但是使用不方便，也不能连续填写多个表格，长距离线路勘察中线转点少则几十个，多则上千，中线数据可由计算直接生成，能否利用中线数据直接填表出图。

　　利用AutoCAD二次开发，编写中线成果填写程序（zxcg．lsp），改变以往出图工序（填写、校对），大大提高工作效率。

一、程序功能与编写说明

　　1、本程序具有下列功能：

　　（1）直接在文本编辑器（EDIT、QE、WPS等等）编辑、修改数据，免去AutoCAD文字编辑、修改之不便；

　　（2）可以自动分页，自动填写工程名称、档案号、日期等等；

　　（3）可以自动处理中线成果数据前后的空格，例如：

　　“123123．123”将自动转化为“123123．123”；

　　（4）可以自动识别两种工程名称数据文件；

　　（5）文本状态下数据正确无误，出图前无需在AutoCAD中修改，调图速度和重新成图速度相差无几，可直接保存数据文件，节省磁盘空间。

　　2、程序说明：

　　程序利用AutoLISP的计算、判断、字符处理、循环结构以及调用Text命令等功能对读入的数据进行处理后填写，与本程序对应的Zxcg．dwg图形文件含四个表格图块，程序中的有关参数均取决于四个图块。

二、使用说明

　　1、关于中线成果数据格式：

　　（1）无曲线

　　第一行，总点数（N）

　　第二至七行，点名（NAME）、里程（K）、高程（H）、坐标X、Y、转角（B）……重复二至七行（没有数据项用空行代替）

　　（2）有曲线

　　第一行，总点数（N）

　　第二至十一行，点名（NAME）、里程（K）、高程（H）、坐标X、Y、转角B，半径R，切线长T、曲线长L、外矢矩E……重复二至十一行（没有数据项用空行代替）

　　2、关于工程名称数据格式：

　　（1）单标题

　　第一行，工程名称

　　第二行，档案号（如测－3777／表，只需输入3777）

　　第三行，日期（可省略，取当前日期）

　　（2）双标题

　　第一行，工程名称大标题

　　第二行，工程名称小标题

　　第三行，档案号（如测－3777／表，只需输入3777）

　　第四行，日期（可省略，取当前日期）

三、加载及运行

　　在AutoCADR12（或AutoCADforWindows）中，把Zxcg．lsp和Zxcg．dwg拷贝到SUPPORT子目录下，用鼠标点文件（File）下应用程序（Applications），或在Command：下敲入Appload加载Zxcg．lsp，或在Command：下敲入（Load“Zxcg”）即可。然后在Command：下敲入ZX运行程序，本程序将中文提示。

四、结束语

　　该应用程序提供了两种形式的表格，有兴趣的AutoCAD用户不妨增加几种表格，修改程序中对应的参数即可。

　　附源程序

  　．．．＊＊＊＊ERROR＊＊＊＊

　　（DEFUNERR（X）

　　；IFANERROR（SUCHASCTRL－C）　　OCCURS

　　；WHILETHISCOMMANDISACTIVE

　　（IF（AND（／ΚX″FUNCTIONCANCELLED″）

　　（／ΚX″QUIT／EXITABORT″））

　　（PPINC（STRCAT″ιnERROR：″X）））

　　（SETVAR″CMDECHO″1）（SETVER″BLIPMODE″1）

　　（IF（ΚTYPERF）′FILE）（CLOSERF））

　　（IF（ΚTYPERN）′FILE）（CLOSERN））

　　（SETQRFNIL）（SETQRNNIL）

　　（SETQ＊ERROR＊OLDERR）

　　；RESTOREOLD＊ERROR＊HANDLER

　　（PRINC））

　　．．．＊＊＊＊FILETOREAD＊＊＊＊

　　（DEFUNINPUT（）

　　（IF（ΚFF1nil）（SEFQFF1（GETVAR″DWGPREFIX″）））

　　（SETQF1（GETFILED″请输入中线成果数据文件″FF1″DAT″12））

　　（SETQLF（STRLENF1）FF1（SUBSTRF11（－LF4）））

　　（IF（ΚFF2nil）（SETQFF2FF1））

　　（SETQF2（GETFILED″请输入工程名称文件″FF2″TXT″12））

　　（SETQLF（STRLENF2）FF2（SUBSTRF21（－LF4）））

　　（initget″YesNo″）

　　（setqYN（getkword″ιn请选择有曲线元素Yes／No：（N）″））

　　（if（ΚYNnil）（SETQYN″No″）））

　　．．．＊＊＊＊DATAFORPROGRAMME＊＊＊＊＊

　　（DEFUNDDAT（）

　　（SETQRF（OPENF1″r″））（SETQRN（OPENF2″r″））

　　（SETQGN（READ－LINERN）GG1DAH（READ－LINERN））

　　（IF（ΚATOIDAH）0）（PROGN（SETQGG2GN2DAHDAH（READ－LINERN））））

　　（SETQDAT（READ－LINERN））

　　（IF（ΚDATNIL）（PROGN（SETQDAT（GETVAR″CDATE″））；取当前日期

　　（SETQDAT（FIXDAT））（SETQDAT（ITOADAT））

　　（SETQYY（SUBSTRDAT14）MM（SUBSTRDAT52））

　　（SETQDD（SUBSTRDAT72）DAT（STRCATYY″－″MM″－″DD））））

　　（SETQNO（READ－LINERF）N（ATOINO））

　　（SETQNF26NN29）；首、次页行数

　　（SETQM（FIX（＋（／（－NNF）NN）2）））：计算页数

　　（SETQNL（REM（－NNF）NN））（IF（ΚNL0）（SETQM（－M1）NLNN））

　　（IF（ΙΚNNF）PROGN（SETQM1）（SETQNLN）））

　　（princ″共读入″）（PRINCN）（PRINC″点，分″）（PRINCM）（PRINC″页填写！″）

　　（SETQYY8XX230）；行距、页距

　　（SETQI1X00Y00DAH（STRCAT″测－″DAH″／″））

　　（IF（ΚYN″NO″）（SETQDI（LIST678．58103．58125．08150．08180．08208．08））

　　（SETQDI（LIST1071．9088．39105．58122．61140．30156．83172．86188．07208．00232．73））））

　　；表格项数及各项横坐标（X）

　　（SETQYYF285．0YYN305．7）；首、次页第一行纵坐标

　　．．．．＊＊＊＊删除数据前后空格（QKG）＊＊＊＊＊＊

　　（DEFUNQKG（）

　　（SETQLE1）

　　（WHILE（〈LE（STRLENTXT））（RPOGN（SETQLF（＋1LE））

　　（WHILE（Κ（SUBSTRTXT11）″″）（PROGN　　（SETQTXT（SUBSTRTXT2（STRLENTXT）））））））

　　（SETQLE（STRLENTXT））

　　（IF（〉LE2）（WHILE（AND（Κ（SUBSTRTXTLE1）″″）（ΛLE2））

　　（PROGN（SETQLE（－LE1）TXT（SUBSTRTXT1LE））））））

　　．．．．．＊＊＊＊＊ZXTX＊＊＊＊＊＊

　　（DEFUNZXTX（）

　　（PRINC″ιn正在填写中线成果数据，请稍候！″）

　　（WHILE（ΙΚIM）（PROGN（SETQPT0（LISTX0Y0））

　　（SETQP1（LIST（＋X0236．0）348．5））（SETQP2（LIST（＋X0207．0）342．0））

　　（SETQP3（LIST（＋X0227．0）342．0））（SETQP4（LIST（＋X0222．2）335．6））

　　（IF（ΚYN″No″）（IF（ΚI1）（SETQZX″＊PZX－F″）（SETQZX″＊PZX－N″））；图块选择

　　（IF（ΚI1）（SETQZX″＊QZX－F″）（SETQZX″＊QZX－N″）））

　　（COMMAND″INSERT″ZXPT0″1″″0″）

　　（IF（ΚI1）（PROGN（SETQP2（LIST（＋X0207．0）336．0））

　　（SETQP3（LIST（＋X0227．0）336．0））（SETQP4（LIST（＋X0222．2）329．6））

　　（SETQP5（LIST（＋X0125．1）329．5））（SETQP6（LIST（＋X0185．9）329．5））

　　（IF（ΚGG2）（PROGN（SETQP5（LIST（＋X0125．1）333．5））

　　（SETQP6（LIST（＋X0185．9）333．5））（SETQP7（LIST（＋X0135．1）323．5））

　　（SETQP8（LIST（＋X0175．9）323．5））））

　　（COMMAND″TEXT″″S″″HZ″″J″″A″P5P6GN）

　　（COMMAND″TEXT″″J″″M″P4″2．5″″0″DAT）

　　（IF（ΚGG2）（COMMAND）″TEXT″″J″″A″P7P8GNZ））））

（IF（ΚI1）（SETQJNF）（SETQJNN））

用VB5直接控制Excel 97

用VB5可编写直接控制Excel操作的程序,方法是用VB的OLE自动化技术获取Excel 97 的控制句柄,从而直接控制Excel 97的一系列操作。与用VBA语言编写的Excel控制程序相比,两者主要有如下差异:

　　1. 实现VB5对Excel的直接控制后,可在用户所编的程序中调用Ex cel,即从控制界面直接调入Excel,且退出Excel后又回到控制界面,使人看起来就如Excel是依附于用户程序上。这给既想获取Excel的强大支持,又想编写"傻瓜"软件交给不熟悉计算机的用户使用的程序员来说,其好处是不言而喻的。VBA则必须依附于特定的Excel环境,且只有先进入确定的Excel环境后,才能运行VBA程序。

　　2. 用VB5实现Excel的控制后,所有程序可编译成完整的EXE执行文件,直接在Win 95 /NT平台上执行,运行环境更为简洁明了,程序更易加密。不会因为有多个程序指令块带来管理麻烦,也不易因用户的不小心使用而出现程序丢失,造成功能短缺。VBA编写的程序最大的不方便是不能编译成执行文件,不能脱离其主应用程序独立运行。

　　3. VBA在Excel环境中,几乎是一个万能的工具,可通过建立功能强大的宏指令来扩展或模拟Excel的全部功能。而VB的OLE自动技术目前还不能实现Excel所有功能的模拟与控制。

　　操作步骤

　　用VB5控制Excel 97的操作步骤如下:

　　1. 引用Microsoft Excel类型库:

　　*从"工程"菜单中选择"引用"栏;

　　*选择Microsoft Excel 8.0 Object Library;

　　*选择"确定"。

　　2. 声明显式数据类型:

　　Dim x1 as Excel.Application

　　3. 创建新实例,获取Excel的控制句柄:

　　Set x1=CreatObject("Excel.Application")

　　4. 由于Excel 97启动为不可见,调用后需使其显示出来:

　　x1.Visible=True

　　5. 交还Excel控制句柄:

　　Set x1=Nothing

　　同理,用此方法也可直接控制Word、Access等Microsoft Office 97的其他应用软件,享受其便利和支持。

　　操作程序

　　Private Sub Contral_Excel_97()

　　{

　　Dim x1 as Excel.Application '声明显式数据类型

　　Set x1=CreateObject("Excel.Application")

　　 '创建新实例

　　x1.Workbooks.Add

　　’添加新工作簿

　　x1.Range("A1").Value=5　’A1格赋值

　　x1.Range("A2").Value=8　’A2格赋值

　　x1.Range("A3").Value=16 ’A3格赋值

　　x1.Range("A4").Value=7　’A4格赋值

　　x1.Charts.Add

　　’插入图形

　　x1.ActiveChart.ChartType=x1ColumnClustered

　　’柱状图

　　x1.ActiveChart.SetSourceData Source:=x1.Sheets("Sheet1") .Range("A1:A4")

　　PlotBy:=x1Columns

　　’图形数据来源

　　With x1.ActiveChart

　　’图标题

　　.HasTitle=False　 ’没有总标题

　　.Axes(x1Category,x1Primary).HasTitle=False

　　.Axes(x1Value,x1Primary).HasTitle=True

　　’有Y轴标题

　　.Axes(x1Value,x1Primary).AxisTitle.Characters

　　.Text="销售电视机(台)"

　　End With

　　With x1.ActiveChart.PageSetup ’图形页面设置

　　.CenterHeader="&28" & ListSTNM(Combo2. ListIndex)&"逐日电视机销售"

　　’标题

　　.CenterFooter="&12x x x 商场"　’下边落款

　　.RightFooter=Format(Now,"yyyy-m-d-h:n")

　　’右下角显示时间

　　.Orientation=x1Landscape　 ’打印纸页面横向

　　End With

　　x1.ActiveChart.PlotArea.Interior.ColorIndex=x1None

　　’无背景色

　　x1.ActiveWindow.SelectedSheets.PrintPreview

　　’打印预览

　　x1.Visible=True

　　’显示图形

　　Set x1=Nothing

　　’交还控制句柄

　　}

VB中使用Word的“艺术字”工具

　　Word 97中的“艺术字”工具(WordArt)能创建出各种各样的文字，令人赏心悦目。如果能在VB中使用“艺术字”该有多好啊！由于有了面向对象技术中的代码重用思想，现在就可以轻松地实现这个愿望了。

　　代码重用主要有两种形式，即二进制代码重用与源代码重用。前者是通过创建和使用对象来实现的；后者，顾名思义，是通过继承实现的，后者在C++语言中被广泛使用。由于Visual Basic不支持继承，所以在VB中的代码重用主要是指二进制代码重用，并且VB算得上是二进制代码重用的先驱。它的基本思路是：首先将待重用的代码和数据编译为二进制文件，称为ActiveX服务器部件，然后在客户应用程序里创建部件中类的对象来调用该部件。在VB中最为人们所熟悉的控件就是典型的二进制代码重用的例子，每个控件都是一个ActiveX部件，在向窗体中添加一个控件的同时就创建了该控件类的一个新实例，然后通过调用该控件的属性、方法和事件就重用了该控件中的代码。

　　Word 97本身就是一个庞大的代码部件，也就是说，Word 97中的整个对象库是对外开放的，它允许其他应用程序对其进行编程。换句话说，Word 97中的对象能被其他应用程序所调用。而“艺术字”正是Word 97中的一种对象，因此可以方便地在VB中调用它。

　　要使用“艺术字”，必须先把Word 97的对象库加入到程序中，然后创建一个对象变量来保持对Word应用程序对象的引用，可以用两种方法创建对Word应用程序对象的引用，一种方法是直接声明一个Word应用程序的对象变量，例如：

　　Dim w As New Word.Application

　　这种方法称为前期绑定，它速度较快；另一种方法是声明一个对象变量w，然后把用CreateObject函数创建出的Word应用程序对象赋给w，例如：

　　Dim w As Object

　　Set w=CreateObject("Word.Application")

　　这种方法称为后期绑定，它速度较慢。在创建了Word应用程序对象后，就可以以代码的方式像在Word中进行具体操作那样创建新文档，并在文档中加入“艺术字”。在创建好“艺术字”之后，用剪贴板将其传给窗体。在创建Word应用程序对象时，VB会在后台自动打开Word，因此，在程序结束时，应该先关闭Word，其代码如下：

　　w.Quit wdDoNotSaveChanges

　　下面用一个具体的项目实例帮你轻松学习如何在VB中使用Word对象。

　　(1)启动Microsoft Visual Basic 5.0，选择“标准EXE”，创建一个新项目；

　　(2)选择“项目”菜单中的“引用”选项，显示“引用”对话框，选中"Microsoft Word 8.0 Object Library"和"Microsoft Office 8.0 Object Library"两项，单击“确定”按钮（见图1）；

　　添加对Word对象库的引用

　　(3)将下列代码加入到Form1的“通用”|“声明”选项中：

　　Dim w As New Word.Application

　　(4)将下列代码加入到Form1的Load事件中：

　　Private Sub Form_Load()

　　 w.Documents.Add.Select

　　 w.ActiveDocument.Shapes.AddTextEffect(0,"艺术字","隶书",48#,-1,0,183.75,70.5).Select

　　End Sub

这里显示的字样是隶书的“艺术字”三个字，你可以根据自己的喜好来改变字体（如宋体、楷体等）以及改变字样；

　　(5)将下列代码加入到Form1的Click事件中：

　　Private Sub Form_Click()

　　 w.Selection.ShapeRange.TextEffect.PresetTextEffect = Int(Rnd(1) * 30)

　　 w.Selection.ShapeRange.TextEffect.FontName = "隶书"

　　 w.Selection.Copy

　　 Picture = Clipboard.GetData()

　　End Sub

　　(6)将下列代码加入到Form1的Unload事件中：

　　Private Sub Form_Unload(Cancel As Integer)

　　 w.Quit wdDoNotSaveChanges

　　 Set w = Nothing

　　End Sub

　　(7)在窗体上放置一个按钮，其Caption属性为"Exit"，并在它的Click事件中处理退出：

　　Private Sub Command1_Click()

　　 End

　　End Sub

　　(8)运行程序后，当鼠标在窗体上单击时，会随机地显示出一种“艺术字”字型（Word中共有30种内建“艺术字”字型），下图分别给出了隶书与宋体两种不同字体的字样为“艺术字”的几种情形。

　　在VB窗体中显示的Word中的“艺术字”，左面是隶书，右面是相应的宋体

　　同样，由这个实例可以举一反三，即我们也可以在VB中使用Excel的图表、PowerPoint的幻灯片，因为Office 97中的产品都是代码部件，这些产品中的对象库都是可以被其他应用程序调用的，所以只要了解这些对象的外部接口（属性、方法和事件），就可以方便地调用这些对象了。PCC

基于AutoCAD R14和VB5开发的数控自动编程系统

1　引言

　　数控零件加工程序的编制是进行数控加工的一个重要步骤，国内外数控加工统计说明，造成数控机床等待约20%～30%是编程不及时所致，可见数控编程直接影响着数控机床的加工效率。随着数控技术应用的日益扩大，我国企业在数控自动编程应用方面已有较大发展，目前主要有以下三种自动编程方式。

　　(1)采用数控编程语言的自动编程。最著名的是APT(Automatically Programmed Tools)语言。

　　(2)计算机辅助图形设计的自动编程。采用CAD方法，将设计好的零件图形显示在屏幕上，编程人员指定要加工的表面，并回答软件提出的一些问题，诸如对刀点、走刀方式、切削用量参数等，然后由系统进行自动编程，形成刀位数据文件或APT程序，再经后置处理，变成机床所需的NC代码。

　　(3)从CAD获取信息的自动编程。编程所需的零件形状信息直接从CAD那里得到，一般利用AutoCAD提供的图形交换文件DXF接口，编程人员只需进行适当工艺处理。

　　由于图纸上给出的零件形状数据往往比较少，而数控系统的插补功能要求有较多的数据才能控制机床。尤其是当数控系统插补功能要求输入的数据与零件形状给出的数据不一致时，就需要进行复杂的数学运算，而在运算过程中可能产生人为的错误。而这些复杂的数学运算可由计算机快速、准确地完成。

　　NC程序作为数控加工的信息载体，其正确与否直接影响零件加工质量。目前实际生产使用的NC程序，在投入加工之前通常采用机床空运行和木模、蜡模的试切，完成NC程序的检查。该方法加工准备周期长，生产成本增加，难以实现数控机床的高效生产。图形仿真是目前CAD/CAPP/CAM系统中通用的NC检验方法。

　　本文介绍了作者开发的数控软件(Numerical Control Automatic Programming System——NCAPS)设计方案和实现方法。操作人员在实际操作数控铣床加工工件之前，先用该系统进行模拟操作。通过计算机屏幕可清晰地看到所编辑的加工程序运行的刀具切削模拟过程，并可方便地反复修改加工程序，直到被加工的“工件”符合要求为止。且该过程都在AutoCAD环境下实现。这无疑对新产品的开发、安全生产、提高生产效率及减少废品都具有实际意义。

2　ActiveX Automation对象及开发工具介绍

2.1　ActiveX Automation对象

　　(1)顶层是AutoCAD Application,它除具有对象的属性和方法外，还包括两个重要的对象Preferences(参数对象)和Document(文档对象)。Preferences对象是与AutoCAD系统中参数设置相对应的对象，Document对象则是包括图形文件的所有对象集合，如Blocks Collection、ModelSpace Entities Collection、PaperSpace Entities Collection等一系列对象。

　　(2)图形对象。Blocks Collection等属于图形对象，它是用户使用频繁的对象，是实现参数化、变量化及三维实体造型等功能的主要方式。

　　(3)输出对象。输出对象控制图形文件的输出格式，如设置坐标原点、方向等。

　　(4)实用对象。该对象提供AutoCAD中常用的数据转换、辅助计算等功能。

2.2　开发工具

　　本文以Visual Basic 5.0为开发工具，给出了实例。由于编程思想是相同的，所以该方法可移到Visual C＋＋、Delphi等开发工具上。

　　用VB5实现ActiveX Automation开发的关键是要获得AutoCAD对象的指针，及创建AutoCAD.Application对象，进而创造AutoCAD的文档对象，以实现对AutoCAD中其它对象的访问，完成与AutoCAD的通讯。

3　系统的组成与功能

　　图形交互式自动编程系统处理零件程序的一般过程是：输入零件图形→输入工艺参数→运动轨迹计算→加工模拟→后置处理→程序清单→输出。NCAPS是针对数控铣床开发的，系统框架结构如图1所示，它主要包括进入AutoCAD R14系统绘制零件图、工艺处理、动态校验和数控加工程序输出等功能模块。具体步骤如下：

　　(1)进入AutoCAD R14系统绘制零件图

　　它是AutoCAD实体建模过程。

　　(2)工艺处理

　　它是第(1)步操作后对图形数据进行再加工的核心模块。利用计算机图形学技术，直接在AutoCAD环境下进行工艺干预。

　　工艺干预内容包括轮廓和点位二种方式，干预过程通过鼠标事件选择实体来实现。用鼠标选取实体的先后来组成加工环(加工路线)。现以VB5编写的源程序说明如何直接从AutoCAD环境下选择实体，形成加工路线(该程序只是该模块的部分)。

　　Option Explicit

　　Public objAcad As Object,objDoc As Object

　　Private Sub Form－Load()

　　　StartAutoCAD-为对AutoCAD访问做准备

　　End Sub

　　Private Sub StartAutoCAD()

　　　Dim DwgName As String

　　　Set objAcad=GetObject(,“AutoCAD.Application”)

　　End Sub

　　Private Sub SelectCutType－Click()

　　　Dim EntityName As String

　　　Dim EntityMessager(1 To 6) As Variant

　　　Dim ent As Object,sset As Object

　　　Set objDoc=objAcad.ActiveDocument

　　　Set sset=objDoc.SelectionSets.Add(“SS1”)‘设置sset到一个名为SS1的选择集中

　　　sset.SelectOnScreen

　　　Dim msgstr As String,appName As String

　　　appName=App.CompanyName

　　　For Each ent In sset

　　　　If ent.EntityName=“AcDbLine”Then‘为直线

　　　　　　EntityName=ent.EntityName

　　　　　　Entitymessager(1)=ent.StarPoint:EntityMessager(2)=ent.EndPoint

　　　　　　ElseIf ent.EntityName=“AcDbCircle”Then‘为圆

　　　　　　EntityName=ent.EntityName

　　　　　　EntityMessager(1)=ent.Center:EntityMessager(2)=ent.Radius

　　　ElseIf ent.EntityName=“AcDbArc”Then‘为圆弧

　　　　EntityName=ent.Entityname

　　　　EntityMessager(1)=ent.Center:EntityMessager(2)=ent.Radius

　　　　EntityMessager(3)=ent.StartAngle:EntityMessager(4)=ent.EndAngle

　　　　EntityMessager(5)=ent.StartPoint:EntityMessager(6)=ent.EndPoint

　　Else

　　　EntityName=ent.EntityName‘为其它实体

　　End If

　Next ent　‘选择集中的下一个实体

End Sub

　　(3)NC代码生成

　　经过工艺干预(即确定刀具走刀路线)后，便可将图形几何信息和工艺干预信息转换成ISO标准数控加工程序代码。同时以（*.NC)形成的文件名永久保存。

　　(4)动态校验

　　上述生成的NC代码是否正确还要进行校验方能制作控制介质输出。本模块采用时间分割插补算法进行动态模拟，以校验ISO数控加工程序代码是否正确，以及刀具与工件是否产生干涉等。如果校验不正确，则需对上述各个环节进行反复调试，直到正确为止。

　　为使刀位数据易于获得，避免传统数值积分法(DDA)精度较差与运算繁琐等缺点，本系统在加工仿真过程中引入方向性概念，使刀心轨迹在算法上简洁明了，程序可读性强。

　　对于CNC系统刀补功能，以往的直线过渡刀补算法，常利用三角函数关系式来计算各转接点的坐标值。这些方法公式推导复杂，计算量大，不宜归纳和简化。本系统引入运动矢量和刀具半径矢量来计算，对直线到直线、直线到圆弧、圆弧到直线和圆弧到圆弧各种转接情况进行了分析，综合为两个统一公式进行计算，大大简化了CNC系统的刀具补偿的计算量。

　　(5)文本编辑模块

　　此模块允许操作人员把已编好的ISO代码形式的数控加工程序通过文本编辑送到计算机，对其加工过程模拟演示，以便验证所编的数控零件加工程序的正确性。

　　(6)数控加工程序输出

　　经调试和检验后的正确数控加工程序可以通过拷贝、打印、通讯接口的方式输出。

4　实例

　　本文以二维零件数控铣削加工为例，首先在AutoCAD环境下绘制零件轮廓，如图2所示。工艺干预可得沿图2所示1-2-3-4-5-6-7-8-9-10-11顺时针方向走刀的ISO数控加工程序，且此程序已通过动态校核检验(如图3)。

图2　工艺干预结果

图3　数控加工(铣削)仿真结果

5　结束语

　　综上所述，本系统具有如下优点：

　　(1)直接在AutoCAD环境下经图形转换，自动生成数控指令代码。由指令代码可以动态模拟刀具运动轨迹，校验代码的正确性。

　　(2)代码可以直接和数控机床通讯，加工出新设计的图形，实现了CAD/CAM一体化。

　　(3)该系统已与数控机床连通，并进行了实际切削。实验表明，该系统具有运行准确、直观，能显著提高数控编程效率等特点，对其中一些功能继续完善，可满足实际加工需要。目前，该系统被我校CAM课程自动编程实验室采用。

利用VBA编程实现从EXCEL表到AUTOCAD表转换(1)

--- 一、前言

---- Microsoft Excel 软件具有十分强大的制表、表格计算等功能，是普通人员常用的制表工具。可以通过其内嵌的VBA语言可以控制Microsoft Excel 的整个操作过程。

---- AutoCAD是由AutoDesk公司的工程绘图软件，是CAD市场的主流产品，功能十分强大，是工程制图人员常用的软件之一。AutoDesk公司从R14版以后，为其提供了VBA语言接口。

---- 在工程制图中，常常需要在图中插入绘制表格，一般有两种方法。其一，是利用剪贴板，将Microsoft Excel表格拷贝至剪贴板中，然后打开AutoCAD文件，再将剪贴板中的文件粘贴至所需位置。这种方法十分简单，但有其固有的缺点。①在保存文件必须将.xls和.dwg文件保存在一起，一旦缺少excel环境，则再对表格继续修改。②同时打开多个表格操作，需要占据较大的内存空间。③文件体积变得很大，表格有时在.dwg文件中以图标形式显示，不便于观察。

---- 第二种方法，即利用Microsoft Excel、AutoCAD都提供的VBA功能，编制程序进行转换，将Microsoft Excel表格按原来样子转换，即把Microsoft Excel表格中的文字和线条信息全部读取出来，在AutoCAD文件里按照一一对应的方式写出来，确保转换后的表格与原表格一致。这样彻底避免了前种方法的缺点，便于表格内容编辑。本文着重介绍此方法。

---- 二、表格转换工作机理分析及具体实现方法

---- 1．表格转换工作机理分析

---- 在制表过程中，经常遇到两个概念，表和方格。

---- 在Microsoft Excel中，与表对应的对象是工作表（Sheet或Worksheet）,与每一个表格方格相对应的对象是单元格区域（range），它可以仅包括一个单元格（cell）,也可以由多个单元格合并而成。

---- 在AutoCAD中，没有与表对应的对象，但表可以理解由若干条线和文字对象组合而成。

---- 根据上述分析，可以发现如下的转换方法：

---- 读取Microsoft Excel文件中的最小对象----单元格区域(range)的主要信息---线条和文字，然后在AutoCAD文件里在指定图层、位置画线条，书写文字。通过循环，遍历所有单元格区域(range),边读边写，最终完成表格的转换。转换过程中，保持线条、文字及其相关属性不发生改变。

---- 下面就转换工作的两个主要对象表格线条和表格文字进行讨论。

---- 2、表格线条的转换

---- Microsoft Excel 中内嵌的VBA为我们获取Excel文件信息提供了极大便利。通常，通过访问range对象，可以获得许多信息。访问分析表格的属性应从分析range开始。每一个range包括许多对象和属性,例如,font对象可以返回range的字体信息。通过遍历,即可获得整个表格信息。获取表格信息的目的在于准确地按照位置画表格线，同时确定文字位置。

---- 在获取表格信息时，存在一个最佳算法问题。以下就画线问题为例，阐明问题和解决方法。

---- 假设表格由a(a>=1)行b(b>=1)列组成,x，y为循环变量, 表格完全由单元格组成，由于在每个单元格都有4条边，让x从1开始循环到a, 再y从1开始循环到b,读取每个单元格的4条边,会读取a*b*4次，重复读取a*b*2次。当x=1时，读取上边；当y=1时读取,左边，其余情况读取右边，下边。共读取a+b+ a*b*2次。以3行4列为例，共读取3+4+3*4*2=31次，与实际表格的边数相同，没有重复读取。

---- 对合并单元格信息的读取是个难点。因为如果按照单元格的位置依次读取，那么由a行b列个单元格（cell）合并而成的单元格区域(range)仅有4条边，采用上述计算方法，需要读取a+b+ a*b*2次，重复读取a+b+ a*b*2 - 4次。以以3行4列为例，共读取3+4+3*4*2=31次，重复读取31 - 4=27次。算法有重复。如果按照行号，列号读取，合并单元格的行号、列号只有一个，其值为最靠左、靠上的那个单元格的行号、列号。例如，将A2：E5的单元格合并后，其行号为2，列号为A。这样由多个合并单元格组合后的表格行号、列号有间断，不连续，无法进行循环读取信息。笔者通过研究发现，函数address（）和单元格的mergearea属性可以获得合并单元格的准确信息。具体方法为：读取cells(x,y)单元格时，用address()判断包含cells(x,y)单元格的合并单元格区域c.mergearea的绝对地址,如果前4个字符与cells(x,y) 单元格的地址相同，为cells(x,y)单元格为合并单元格区域最靠上、靠左的那个合并单元格，读取其4条边信息，否则不读取。这样，彻底避免了重复读取，同时提高了整个读取和画线速度。

---- 在AutoCAD中，线条有多种，考虑能够方便控制线条属性，选用了多义线。具体命令如下： RetVal = object.AddLightWeightPolyline(VerticesList)

---- 下面的程序演示表格线条读取和画表格线的具体过程。

Sub hxw()

Dim a as interger ‘表格的最大行数

Dim b as interger ‘表格的最大列数

Dim xinit as double ‘插入点x坐标

Dim yinit as double ‘插入点y坐标

Dim zinit as double ‘插入点z坐标

Dim xinsert as double ‘当前单元格的左上角点的x左标

Dim yinsert as double ’当前单元格的左上角点的y左标

Dim ptarray (0 to 2) as double

Dim x as integer

Dim y as integer

For x =1 to a

       For y=1 to b

       Set c = xlsheet.Range(zh(y) + Trim(Str(x)))

‘以行号、列号获得单元格地址

       Set ma = c.MergeArea

                     ‘求出单元格C的合并单元格地址

            If Left(Trim(ma.Address), 4) = Trim(c.Address) Then

假如c.mergearea的绝对地址,如果前4个字符与c单元格的地址相同

                xl = "A1:" + ma.Address

                xh = xlsheet.Range(ma.Address).Width

                yh = xlsheet.Range(ma.Address).Height

                Set xlrange = xlsheet.Range(xl)

                xinsert = xlrange.Width  - xh

                yinsert = xlrange.Height  - yh

                xpoint = xinit + xinsert

                ypoint = yinit - yinsert

                If x = 1 Then

                    If ma.Borders(xlEdgeTop).LineStyle

               <> xlNone Then

                        ptArray(0) = xpoint   

        ‘第一点坐标（数组下标 0 and 1)

                        ptArray(1) = ypoint

                        ptArray(2) = xpoint + xh

       ‘第二点坐标（数组下标 2 and 3)

                        ptArray(3) = ypoint

                      End If

Lineweight lwployobj, ma.Borders(xlEdgeTop).Weight

                End If                

                If ma.Borders(xlEdgeBottom).LineStyle

              < > xlNone Then

                     ptArray(0) = xpoint + xh 

         ‘第三点坐标（数组下标 0 and 1)

                     ptArray(1) = ypoint - yh

                     ptArray(2) = xpoint 

       ‘第四点坐标（数组下标 2 and 3）

                     ptArray(3) = ypoint – yh

                     Lineweight lwployobj,

        ma.Borders(xlEdgeBottom).Weight

                End If

                If y = 1 Then

                     If ma.Borders(xlEdgeLeft).LineStyle

        < > xlNone Then

                         ptArray(0) = xpoint   

         ‘第四点坐标（数组下标 0 and 1)

                         ptArray(1) = ypoint - yh

                         ptArray(2) = xpoint 

       ‘第一点坐标（数组下标 2 and 3)

                         ptArray(3) = ypoint

                     End If

 Lineweight lwployobj, ma.Borders(xlEdgeLeft).Weight

                End If         

                If ma.Borders(xlEdgeRight).LineStyle

        < > xlNone Then

                     ptArray(0) = xpoint + xh 

         ‘第二点坐标（数组下标 0 and 1)

                     ptArray(1) = ypoint

                     ptArray(2) = xpoint + xh

       ‘第三点坐标（数组下标 2 and 3）

                     ptArray(3) = ypoint – yh

                     Lineweight lwployobj,

        ma.Borders(xlEdgeRight).Weight

                End If           

    Set lwployobj = moSpace.AddLightWeightPolyline(ptArray)    

‘在AutoCAD文件里画线

    With lwployobj

        .Layer = newlayer.name ‘指定lwployobj所在图层

        .Color = acBlue   ‘指定lwployobj的颜色

    End With

Lwployobj.Update  

       Next y

Next x

End Sub

‘下面程序控制线条粗细

Sub Lineweight(ByVal line As Object, u As Integer)

    Select Case u

        Case 1

            Call line.SetWidth(0, 0.1, 0.1)

        Case 2

            Call line.SetWidth(0, 0.3, 0.3)

        Case -4138

            Call line.SetWidth(0, 0.5, 0.5)

        Case 4

            Call line.SetWidth(0, 1, 1)

        Case Else

            Call line.SetWidth(0, 0.1, 0.1)

    End Select   

End Sub

‘下面程序完成列号转换

Function zh(pp As Integer) As String

    If pp < 26 Then

        zh = Chr(64 + pp)

    Else

        zh = Chr(64 + Int(pp / 26)) + Chr(64 + pp Mod 26)

    End If

End Function

-- 3、表格文字转换

---- 表格文字转换包括表格文字本身转换和表格文字在表格中位置的转换两个部分。

---- 在AutoCAD中，文字标注的形式有多种，与Microsoft Excel 单元格区域多行文本内容相对应的是多行文本命令。AutoCAD提供的VBA添加多行文本的命令语句是：

RetVal = object.AddMText(InsertionPoint, Width, Text)

---- 通过修改RetVal的属性可以控制表格文字在表格中的位置。

---- (1)．表格文字本身的转换

---- 分析AddMText命令可以得出：表格文字所在位置、文字内容宽度，文字内容，均可通过此命令来添加。然而表格文字字体，大小，下划线、上下脚标，倾斜，加粗等却不能。一般的方法是采用修改字体形文件的方法来实现，方法烦琐，不便于实现，而且仅对修改过形文件的字体有效。况且当同一文字块内的不同文字的字体，大小，下划线、上下脚标，倾斜，加粗不同时，使用修改字体形文件的方法也无法实现。本文介绍一种直接利用Mtext命令提供的方法进行转换。

---- 在AddMText命令中，影响文字内容和文字属性的参数Text。在具体文字前加上一定的控制符号可以控制文字的文字属性，具体控制符号可以参阅AutoCAD帮助文件。例如，{\F宋体；\Q18;\W1.2;ABCDEFG}把“ABCDEFG”设置成宋体、向右倾斜18度，每个字的宽度是正常宽度1.2倍。

---- 本程序具体采用的方法是：读取Microsoft Excel文件某一单元格区域里的某第j个字符属性（字体，大小，下划线、上、下脚标，倾斜，加粗），读取Microsoft Excel文件某一单元格区域里的某第j+1个字符属性，如果与第j个字符相同，则二者采用同样的控制符号；若不同，则从第j+1个字符开始，重复前面的工作。

Sub wz (  )

Char = RTrim(Left(c.Characters.Caption, 256))

If Char < > Empty Then

   textStr = ""

   For j = 1 To Len(Char)

  If c.Characters(j, 1).Font.Underline =

        xlUnderlineStyleNone Then

          cpt = c.Characters(j, 1).Caption

          sonstr = ForeFontStr(c, j)

          tempstr = ""

          Do While j + 1 < = Len(Char)

               sonstr1 = ForeFontStr(c, j + 1)

               If sonstr1 = sonstr Then

                  j = j + 1

                  tempstr = tempstr + c.Characters(j,

       1).Caption

               Else

                  Exit Do

               End If

          Loop

          textStr = textStr + "{" + sonstr + cpt

        + tempstr + "}"

      Else

          cpt = c.Characters(j, 1).Caption

          sonstr = ForeFontStr(c, j)

          tempstr = ""

          Do While j + 1 < = Len(Char)

              sonstr1 = ForeFontStr(c, j + 1)

              If sonstr1 = sonstr Then

                 j = j + 1

                 tempstr = tempstr + c.Characters(j,

        1).Caption

              Else

                 Exit Do

              End If

       Loop

           textStr = textStr + "{\L" +

           sonstr + cpt + tempstr + "\l}"

       End If

   Next j

End If

End Sub   

‘下面函数控制字体本身属性

Function ForeFontStr(m As Range, u As Integer) As String

a1 = "\F" + m.Characters(u, 1).Font.Name + ";"  ‘字体

a2 = IIf(m.Characters(u, 1).Font.Superscript =

True, "\H0.33x;\A2;", "")  '上脚标

a3 = IIf(m.Characters(u, 1).Font.Subscript =

True, "\H0.33x;\A0;", "")  '下脚标

a4 = IIf(m.Characters(u, 1).Font.FontStyle =

"倾斜", "\Q18;", "")  '倾斜

a5 = IIf(m.Characters(u, 1).Font.FontStyle =

 "加粗", "\W1.2;", "")  '加粗

a6 = IIf(m.Characters(u, 1).Font.FontStyle =

"加粗 倾斜", "\W1.2;\Q18;", "")  ' 加粗倾斜 

 ForeFontStr = a1 + a2 + a3 + a4 + a5 + a6

End Function

---- （2）.表格中表格文字位置的转换

---- 对文字对象的属性的直接控制来实现，通过with….end with 结构可以很容易地控制文字的高度、图层、颜色、书写方向。由于Mtext文字提供支持的排列位置分为9种，必须根据Microsoft Excel表格文字的排列方式加以合适的判定，然后进行转换。其具体的实现方法详见下面的程序。

Sub kz( )

With textObj ‘文字对象

    .Height = textHgt

    .Layer = newlayer.Name  ‘设置图层

    .Color = acRed          ‘设置颜色

    .DrawingDirection = 1    ‘设置书写方向

   If (ma.VerticalAlignment = xlTop _

       Or ma.VerticalAlignment = xlGeneral) _

       And (ma.HorizontalAlignment = xlLeft _

       Or ma.HorizontalAlignment = xlGeneral) _

       Then .AttachmentPoint = 1  'acAttachmentPointTopLeft

   If (ma.VerticalAlignment = xlTop _

       Or ma.VerticalAlignment = xlGeneral) _

       And (ma.HorizontalAlignment = xlCenter _

       Or ma.HorizontalAlignment = xlJustify _

       Or ma.HorizontalAlignment = xlDistributed) _

       Then .AttachmentPoint = 2  'acAttachmentPointTopCenter

   If (ma.VerticalAlignment = xlTop _

       Or ma.VerticalAlignment = xlGeneral) _

       And ma.HorizontalAlignment = xlRight _

       Then .AttachmentPoint = 3  'acAttachmentPointTopRight

   If (ma.VerticalAlignment = xlCenter _

       Or ma.VerticalAlignment = xlJustify _

       Or ma.VerticalAlignment = xlDistributed) _

       And (ma.HorizontalAlignment = xlLeft _

       Or ma.HorizontalAlignment = xlGeneral) _

       Then .AttachmentPoint = 4  'acAttachmentPointMiddleLeft

   If (ma.VerticalAlignment = xlCenter _

       Or ma.VerticalAlignment = xlJustify _

       Or ma.VerticalAlignment = xlDistributed) _

       And (ma.HorizontalAlignment = xlCenter _

       Or ma.HorizontalAlignment = xlJustify _

       Or ma.HorizontalAlignment = xlDistributed) _

       Then .AttachmentPoint = 5  'acAttachmentPointMiddleCenter

   If (ma.VerticalAlignment = xlCenter _

       Or ma.VerticalAlignment = xlJustify _

       Or ma.VerticalAlignment = xlDistributed) _

       And ma.HorizontalAlignment = xlRight _

       Then .AttachmentPoint = 6 'acAttachmentPointMiddleRight

   If ma.VerticalAlignment = xlBottom _

       And (ma.HorizontalAlignment = xlLeft _

       Or ma.HorizontalAlignment = xlGeneral) _

       Then .AttachmentPoint = 7  'acAttachmentPointBottomLeft

  If ma.VerticalAlignment = xlBottom _

       And (ma.HorizontalAlignment = xlCenter _

       Or ma.HorizontalAlignment = xlJustify _

       Or ma.HorizontalAlignment = xlDistributed) _

       Then .AttachmentPoint = 8  'acAttachmentPointBottomCenter

  If ma.VerticalAlignment = xlBottom _

       And ma.HorizontalAlignment = xlRight _

       Then .AttachmentPoint = 9  'acAttachmentPointBottomRight

End With

textObj.Update

End Sub

---- 三、功能与特点介绍

---- 该程序可将Excel表格中的所有单元格全部按原来大小、风格转换到AutoCAD文件中来。在转换过程中，表格线条的转换和文字转换是重点。文字转换采用了直接利用AddMtext命令提供的属性进行转换，避免了已往修改形文件来进行文字标注的方法，直接控制表格文字字体、大小、下划线、上下脚标，倾斜，加粗等，使每个文字的风格均可以得到很好的控制，极大提高了文字标注的灵活性。

---- 本程序采用Visual BASIC编制，需要Microsoft Excel 2000和AutoCAD R14运行环境，编译后通过。

Option Explicit

Dim x(1 To 4, 1 To 5) As Integer

Private Sub Command1_Click()

    Dim i As Integer

    Dim j As Integer

    Dim ex As Object

    Dim exwbook As Object

    Dim exsheet As Object

        Set ex = CreateObject("Excel.Application")

    Set exwbook = Nothing

    Set exsheet = Nothing

    Set exwbook = ex.Workbooks().Add

    Set exsheet = exwbook.Worksheets("sheet1")

    ex.Range("c4:g7").Value = x

    ex.Range("c3").Value = "表 格"

    ex.Range("d3").Value = " 春 天 "

    ex.Range("e3").Value = " 夏 天 "

    ex.Range("f3").Value = " 秋 天 "

    ex.Range("g3").Value = " 冬 天 "

     '保存输入到abc.xls

    exwbook.SaveAs "c:\sbc.xls"

    '退出excel

    ex.Quit

End Sub

Private Sub Form_Load()

    Me.Show

End Sub

为AUTOCAD增加"批量"编辑功能6则

4.普通线变多义线函数

(defun C:LTOPL() ;LINE-->PLINE 函 数

(setq s(ssget))

(setq w(getreal"width:")) ； 输 入 线 宽

(setq n(sslength s))

(setq n( －n 1))

(while(>=n 0)

  (setq n1(ssname s n))

  (if(=(cdr(assoc 0(entget n1)))"LINE")

    (command"PEDIT"(cdr(assoc －1(entget n1))) "Y" "w" w "x")

  )

  (setq n( －n 1))

) (princ) )

该函数的功能是将选中的(一批)普通线(LINE线)变换成有宽度的多义线(PLINE线)。

2.修改字高函数

(defun C:HTEXT()              ; 统 一 修 改 字 高

(setq s(ssget))                  ； 选 文 本

(setq h(getreal "height:"))        ； 输 入 字 高

(setq n(sslength s))

    (setq n( －n 1))

(while(> －n 0)

  (setq n1(ssname s n))

  (if(=(cdr(assoc 0(entget n1)))"TEXT")

(command "CHANGE" (cdr (assoc －1 (entget n1)))

                 "" "" "" "" h "" "")

  )

  (setq n( －n 1))

)

(princ)

)

该函数的功能是将选中的(一批)文字(串)的字高修改成统一的高度。