CAD VBA代码

一、基本操作 ................................................................................................................................... 1

1、 块操作 ........................................................................................................................... 1

1.1、定义块方法： .......................................................................................................... 1 1.2、把选择集加入块中的方法 ...................................................................................... 1 1.3、插入块方法： .......................................................................................................... 1 1.4、画块属性方法 .......................................................................................................... 1 1.5、编程思路： .............................................................................................................. 1 2、画直线 (单段线) ................................................................................................................. 3 3、画多段线 ............................................................................................................................. 4

3.1、修改出线点的位置 .................................................................................................. 4 4、画圆 ..................................................................................................................................... 4 5、获取鼠标指定的坐标点 ..................................................................................................... 4 6、旋转 ..................................................................................................................................... 4 7.插入文字（单选） ................................................................................................................ 5

（1）、左边对齐： ........................................................................................................... 5 （2）、中间对齐： ........................................................................................................... 5 （3）、右边对齐 ............................................................................................................... 5 8.插入文字（多行） ................................................................................................................ 5 9、画圆弧 ................................................................................................................................. 6 10、画图椭圆 ........................................................................................................................... 6 11、CAD打开读取数据 ......................................................................................................... 6 12、绘制圆弧 ........................................................................................................................... 6 二、CAD VBA程序答 .................................................................................................................... 7

1. VBA写的宏，可否编译成象ARX一样的程序，经加载后，在命令行打入命令后就可运行........................................................................................................................................... 7 2. VB中可以生成可执行文件，而在VBA中却不行 .......................................................... 7 5.有时文字是从别的图中复制-粘贴的,如果不打破的话,能否直接得到文字内容. ............ 8 GetSubEntity 方法 ................................................................................................................... 8 6. 想必河伯对Excel/ActiveX有研究, 能否请教如何获得Excel文件最后一行的信息? . 8 可以用CurrentRegion属性计算最后一行 ............................................................................. 8 7. 如何调用vba命令对多义线进行fit(拟合)处理 ............................................................... 9 8. 块属性值编辑 ...................................................................................................................... 9 9.如何用程序控制对象捕捉 .................................................................................................. 10 10. 如何从VBA到VB？ ..................................................................................................... 10 11.IntersectWith 方法 ............................................................................................................ 10 12.绘制多边形并显示多边形顶点坐标 ................................................................................ 10 13.Private Sub AcadDocument_BeginDoubleClick(ByVal pPoint As Variant) ...................... 11 14. 现有Handpoint = acadApp.ActiveDocument.Utility.GetPoint(, \请输入套料的插入点\ ................................................................................................................................................ 12 希望用户在捕捉点或输入点坐标动作时，如何避免用户因其他操作如缩放、PAN引起的系统报错 ............................................................................................................................. 12 15.在VBA中如何传送一个参数给Vlisp? .......................................................................... 12 17.我想知道vb中的那个函数或者对象的方法可以代替在cad中按esc键取消命令 .... 12 18点击菜单项就在该菜单上打对号是怎么实现的? .......................................................... 13

第1页

20请问版主，如何实时获得当前光标的X，y，z坐标值，如同状态栏上显示坐标值 13 21可以设置图块中的块属性值，如内 ................................................................................ 13 22我的选择集中有Block和PLine,我想能使用该函数 ..................................................... 14 23我的机器里装有cad14和cad2000,用vb写了一个程序调用cad,如何让程序每次都调用cad2000呢? ....................................................................................................................... 14 24我只是想判断一下 ............................................................................................................ 14 25SendCommand \没有返回值,怎么知道是否添加了line ...................................... 15 26为什么修改文 字的对方正式后辩证文字会移回到零点？ .......................................... 15 27删除块前，应先删除块的引用，怎样查找块的引用？（VBA） ................................ 15 28使用ADO的方法如何存取ACCESS数据库? .............................................................. 15 30如何将类似 \数值改为\显示 ............................................................................... 16 31请问，如何将图上所有的数字（成千上万个数值）减去同一个常数？ .................... 17 34 把选择的对象放大几倍，VBA怎么实现？ ................................................................. 20 35怎样提取图形的视图左下角、右上角和图形左下角，右上角的坐标？ .................... 20 1. 怎么查找某一个group是否存在？- ............................................................................. 21 3. 在编程中，我遇到以下问题： ........................................................................................ 21 5. Sheets(\检测报告\.................................................................................................. 22 6. 请问如何让form.hide后form.show时能保持form先前移动后的位置？.................. 22 9怎样计算一个多边形的中心点? ........................................................................................ 23 10如何返回在命令行中输入的字符,是指在没有按下回车和空格下 ............................... 24 11当我插入块时，鼠标的click_point为两个图块的公共插入点，即同时插入两个块 24 12如何把168.235642度分解成度，分，秒？我没有办法判别小数点？ ....................... 24 13. 请问在VBA中怎么使一个选择集只选中模型空间中可见图元？ ............................ 25 14. windows安装了几个打印机，如何用vb指定打印机。谢谢 ...................................... 26 16请教，VBA中的下拉列表控件的数据是怎么和数据库内的数据邦定的？我查了好些东东都不能搞定，那位仁兄可以相告，谢谢。 ................................................................. 26 17请问高手，在VB中如何将如0.00000053的数字，变成形如5.3E-7字样的科学记数法 ............................................................................................................................................ 27 18.在vba中有 IsNumberic()函数检测变量是不是数值,但我需要一个能检验 所输的变量是不是 字符charactor的函数,或能实现此功能的办法. ................................................ 27 19在ADDMTEXT中，换行符\\p怎么使用啊？ ............................................................... 27 20请大家帮我解一个数学问题 ............................................................................................ 27 22. 如何得到objectDBX及其帮助？ .................................................................................. 28 24. 哪位大侠知道，怎么取得任意图形的中心点坐标！ .................................................. 28 25测量坐标与屏幕坐标的转换 ............................................................................................ 28 26VBA回车响应的问题 ....................................................................................................... 29 27.是根据VBA教材的代码改的批量裁剪程序 ................................................................. 29 28. 我用sendcommand的_trim命令，经常剪不断，怎么办？ ....................................... 31 29关于split()函数的问题 ..................................................................................................... 32 31如何在VB中开关非当前层？ ........................................................................................ 34

第2页

CAD VBA代码 峰

一、基本操作

变量可以不填可不填，在前面加入optional 如optional A as string

1、 块操作

1.1、定义块方法：

Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名) 1.2、把选择集加入块中的方法 ThisDrawing.CopyObjects(选择集,块) 1.3、插入块方法：

ThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度) 1.4、画块属性方法

ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值) 一共有五种模式，在输入时会有提示，其中最常用的是“acAttributeModeNormal”普通模式 1.5、编程思路：

1．定义一个空块

2．在块中画一段弧（球服衣领） 3．画多段线，镜像画出球衣

4．画块属性，由于块属性默认的对齐方式是左对齐，而球员号码应该居中，所以必须把块的对齐属性改为居中。但是当这个属性更改时块属性对齐点会自动归零，所以不得不再次更改对齐点属性

5．把多段线和属性复制到块中 6．提示用户点选球员位置和姓名

7．插入块，修改球衣号码属性、球员姓名属性 Sub team()

Dim playerlay As AcadLayer '定义球员图层 Dim playerblock As AcadBlock '定义块变量 Dim arcc(0 To 2) As Double '圆弧圆心 Dim linep1(0 To 2) As Double '线条端点1

第1页

CAD VBA代码 峰

Dim linep2(0 To 2) As Double '线条端点2

Dim pline(0 To 20) As Double '定义队服右侧多段线7个顶点 Dim basep(0 To 2) As Double '块基点

Dim playernumberpoint(0 To 2) As Double '块属性插入点 Dim mytxt As AcadTextStyle '定义mytxt变量为文本样式 Dim blockRef As AcadBlockReference '定义块属性变量 Dim Attr3 As Variant '插入块属性变量

Set playerblock = ThisDrawing.Blocks.Add(basep, \球员\定义一个\球员\的块 arcc(0) = 0 arcc(1) = 430

Call playerblock.AddArc(arcc, 50, ThisDrawing.Utility.AngleToReal(180, 0), 0) '画弧并加入块中

pline(0) = 0 pline(1) = 20 pline(3) = 100 pline(4) = 20 pline(6) = 100 pline(7) = 250 pline(9) = 125 pline(10) = 207 pline(12) = 212 pline(13) = 257 pline(15) = 112 pline(16) = 430 pline(18) = 50 pline(19) = 430

Set line1 = ThisDrawing.ModelSpace.AddPolyline(pline) '画队服右侧多段线 linep2(1) = 1 '镜像轴第二点位于Y轴上任一点

Set line2 = line1.Mirror(linep1, linep2) '镜像获得另一半多段线 Dim p(0 To 2) As Double '定义坐标变量

Set mytxt = ThisDrawing.TextStyles.Add(\添加mytxt样式 mytxt.fontFile = \设置字体文件为仿宋体 ThisDrawing.ActiveTextStyle = mytxt '将当前文字样式设置为mytxt playernumberpoint(0) = 0 '块属性位置 playernumberpoint(1) = 200

Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, \号码\playernumberpoint, \画块属性 attr1.Alignment = 7 '居中

attr1.TextAlignmentPoint = playernumberpoint '重定义对齐点

Set attr2 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, \姓名\playernumberpoint, \画块属性 attr2.Alignment = 7 '居中

Dim objCollection(0 To 3) As Object '创建选择集 Set objCollection(0) = line1 '线条1加入选择集

第2页