CADVBA代码.docx

CADVBA代码.docx

《CADVBA代码.docx》由会员分享，可在线阅读，更多相关《CADVBA代码.docx（11页珍藏版）》请在冰豆网上搜索。

CADVBA代码

一、基本操作  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

二、CADVBA程序答  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.PrivateSubAcadDocument_BeginDoubleClick（ByValpPointAsVariant）  11

14.现有Handpoint=acadApp.ActiveDocument.Utility.GetPoint（,"请输入套料的插入点"）  12

希望用户在捕捉点或输入点坐标动作时，如何避免用户因其他操作如缩放、PAN引起的系统报错  12

15.在VBA中如何传送一个参数给Vlisp?

  12

17.我想知道vb中的那个函数或者对象的方法可以代替在cad中按esc键取消命令  12

18点击菜单项就在该菜单上打对号是怎么实现的?

  13

20请问版主，如何实时获得当前光标的X，y，z坐标值，如同状态栏上显示坐标值  13

21可以设置图块中的块属性值，如内  13

22我的选择集中有Block和PLine,我想能使用该函数  14

23我的机器里装有cad14和cad2000,用vb写了一个程序调用cad,如何让程序每次都调用cad2000呢?

  14

24我只是想判断一下  14

25SendCommand"_Line"没有返回值,怎么知道是否添加了line  15

26为什么修改文字的对方正式后辩证文字会移回到零点？

  15

27删除块前，应先删除块的引用，怎样查找块的引用？

（VBA）  15

28使用ADO的方法如何存取ACCESS数据库?

  15

30如何将类似".5"数值改为"0.5"显示  16

31请问，如何将图上所有的数字（成千上万个数值）减去同一个常数？

  17

34把选择的对象放大几倍，VBA怎么实现？

  20

35怎样提取图形的视图左下角、右上角和图形左下角，右上角的坐标？

  20

1. 怎么查找某一个group是否存在？

-  21

3.在编程中，我遇到以下问题：

  21

5.Sheets（"检测报告"）.Select  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

一、基本操作

变量可以不填可不填，在前面加入optional如optionalAasstring

1、块操作

1.1、定义块方法：

Setblocksobj=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．插入块，修改球衣号码属性、球员姓名属性

Subteam（）

DimplayerlayAsAcadLayer'定义球员图层

DimplayerblockAsAcadBlock'定义块变量

Dimarcc（0To2）AsDouble'圆弧圆心

DimLinep1（0To2）AsDouble'线条端点1

Dimlinep2（0To2）AsDouble'线条端点2

Dimpline（0To20）AsDouble'定义队服右侧多段线7个顶点

Dimbasep（0To2）AsDouble'块基点

Dimplayernumberpoint（0To2）AsDouble'块属性插入点

DimmytxtAsAcadTextStyle'定义mytxt变量为文本样式

DimblockRefAsAcadBlockReference'定义块属性变量

DimAttr3AsVariant'插入块属性变量

Setplayerblock=ThisDrawing.Blocks.Add（basep,"球员"）'定义一个"球员"的块

arcc（0）=0

arcc

（1）=430

Callplayerblock.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

Setline1=ThisDrawing.ModelSpace.AddPolyline（pline）'画队服右侧多段线

linep2

（1）=1'镜像轴第二点位于Y轴上任一点

Setline2=line1.Mirror（linep1,linep2）'镜像获得另一半多段线

Dimp（0To2）AsDouble'定义坐标变量

Setmytxt=ThisDrawing.TextStyles.Add（"mytxt"）'添加mytxt样式

mytxt.fontFile="c:

\windows\fonts\simfang.ttf"'设置字体文件为仿宋体

ThisDrawing.ActiveTextStyle=mytxt'将当前文字样式设置为mytxt

playernumberpoint（0）=0'块属性位置

playernumberpoint

（1）=200

Setattr1=ThisDrawing.ModelSpace.AddAttribute（100,acAttributeModeNormal,"号码",playernumberpoint,"X",0）'画块属性

attr1.Alignment=7'居中

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

Setattr2=ThisDrawing.ModelSpace.AddAttribute（100,acAttributeModeNormal,"姓名",playernumberpoint,"?

?

?

",0）'画块属性

attr2.Alignment=7'居中

DimobjCollection（0To3）AsObject'创建选择集

SetobjCollection（0）=Line1'线条1加入选择集

SetobjCollection

（1）=line2'线条2加入选择集

SetobjCollection

（2）=attr1'属性1加入选择集

SetobjCollection（3）=attr2'属性2加入选择集

CallThisDrawing.CopyObjects（objCollection,playerblock）'把选择集加入块中

ForEachelementInobjCollection'在选择集中进行循环

element.Delete'删除线条和属性（此操作并不影响已创建的块）

Next

Setplayerlay=ThisDrawing.Layers.Add（"球员"）'新建图层

playerlay.color=2'为黄色

ThisDrawing.ActiveLayer=playerlay'将当前图层设置为球员图层;

Dimp1AsVariant'块插入点位置

Fori=1To11'插入块

pstring=CStr（i）&"号球员位置：

p1=ThisDrawing.Utility.GetPoint（,pstring）'点选球员位置坐标

nstring=ThisDrawing.Utility.GetString（30,"球员姓名：

"）

SetblockRef=ThisDrawing.ModelSpace.InsertBlock（p1,"球员",1,1,1,0）'插入块

Attr3=blockRef.GetAttributes'获取块属性

Attr3（0）.TextString=CStr（i）'赋值球员号码

Attr3

（1）.TextString=nstring'赋值球员姓名

Next-

EndSub

SetmBlock=ThisDrawing.Blocks.Add（insertPt,tmpName），其中mBlock是AcadBlock对象，insertPt是插入点的坐标（相对与块），tmpName是块的名称。

块和块的实例是两个概念。

块只能有一个，但是这个块的实例却可以有很多个。

使用上述方法得到的是块，而不是块的实例。

你能够在CAD菜单栏“插入-块”所打开的对话框中看到名字为tmpName的块，但是CAD图形中并没有块的图形。

CallThisDrawing.ModelSpace.InsertBlock（Text_P,"图框B",1,1,1,0）

'（座标，X轴扩，Y轴扩，Z轴扩，旋转）

插入块。

2、画直线 （单段线）

Set ln = ThisDrawing.ModelSpace.AddLine（startPt（）, EndPt（））

3、画多段线

Dimp（0To49）AsDouble'定义点坐标

Setmyl=ThisDrawing.ModelSpace.AddLightWeightPolyline（p）'画多段线

myl.Color=co'设置颜色属性

myl.ConstantWidth=2'设置多段线宽度属性

3.1、修改出线点的位置

SetLine2=Line1.Mirror（CC_XYZ,CC_Mir_XYZ）'交叉线2镜像

'修改出线点的位置

a=Line2.Coordinates

a

（1）=a

（1）-（Phase_Number-1-i）*Spacing

Line2.Coordinates=a

4、画圆

拓展程序（将上述画圆的程序拓展为每画一个圆设定为一种颜色）

Subc100（）

Dimcc（0To2）AsDouble'声明坐标变量

cc（0）=1000'定义圆心座标

cc

（1）=1000

cc

（2）=0

DimmylAsObject'定义引用曲线对象变量

co=15'定义颜色

Fori=1To1000Step10'开始循环

Setmyl=ThisDrawing.ModelSpace.AddCircle（cc,i*10）'画圆,cc数组为圆心X、Y、Z值

myl.color=co'设置颜色属性

co=co+1'改变颜色，供下次定义曲线颜色

Nexti

EndSub

5、获取鼠标指定的坐标点

ThisDrawing.Utility.GetPoint（,"输入点:

"）'获取点坐标

6、旋转

NewFilterEnt.Rotate PT, JiaoDu         '更新对象 PT（基点）对你  JiaoDu孤度

NewFilterEnt.Update

文字旋转

SetMy_Text=ThisDrawing.ModelSpace.AddText（Text,Text_XYZ,Text_Hegin）

My_Text.Alignment=acAlignmentCenter   '中心对齐文字acAlignmentMiddleCenter