AutocadVBA初级教程第十三课块操作-Read.DOCVIP

  • 11
  • 0
  • 约5.97千字
  • 约 8页
  • 2018-09-02 发布于天津
  • 举报

AutocadVBA初级教程第十三课块操作-Read.DOC

AutocadVBA初级教程第十三课块操作-Read

Autocad?VBA初级教程?第十三课块操作 作者:普天同庆????文章来源:本站原创????点击数:1411????更新时间:2006-7-11 定义块方法: Set blocksobj=ThisDrawing.Blocks.Add(基点, 块名) 把选择集加入块中的方法: ThisDrawing.CopyObjects(选择集,块) 插入块方法: ThisDrawing.ModelSpace.InsertBlock(插入点,块名, X轴比例,Y轴比例,Z轴比例, 旋转角度) 画块属性方法: ThisDrawing.ModelSpace.AddAttribute(文字高度,模式,提示字符, 插入点, 显示字符,默认值) 一共有五种模式,在输入时会有提示,其中最常用的是“acAttributeModeNormal”普通模式 下面的例题是利用属性块画足球场的阵型图。 程序画出一个球员块,然后把块写到用户指定位置,球员号码由程序自动递增,把球员姓名改为用户输入值。画足球场请参阅上一课内容。 ? 编程思路: 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 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样式 mytxt.fontFile = c:\windows\fonts\simfang.ttf 设置字体文件为仿宋体 ThisDrawing.ActiveTextStyle = mytxt 将当前文字样式设置为mytxt playernumberpoint(0) = 0 块属性位置 playernumberpoint(1) = 200 Set attr1 = ThisDrawing.ModelSpace.AddAttribute(100, acAttributeModeNormal, 号码, playernumberpoint, X, 0) 画块属性 attr1.Alignm

文档评论(0)

1亿VIP精品文档

相关文档