文章目录
本文在AutoCAD 2016环境下测试。
1.打开VBA
- 1.打开VBA
- 2.动作录制
- 3.显示坐标
- 4.VBA宏
- 4.1.绘制多段线
- 4.2.绘制圆
- 4.3.绘制多个多边形
- 5.函数过程调用
- 6.画文字
- 6.1.绘制文字
- 6.2.CAD设置文字字体
- 6.3.CAD设置单位
- 7.范围缩放
- 8.作者答疑
菜单栏 管理》Visual Basic 编辑器。 如果提示缺少VBA模块,官网下载。下载安装完毕,打开如下图所示:
常见的VBA界面。
由于录制的动作,不能用于脚本编辑,笔者认为作用不是很大。
点击右下角的设置图标,然后点击勾选坐标选项。
可以查看文章,VBA语法是通用。VBA基础语法-变量、运算符、函数-CDR插件
4.1.绘制多段线源码如下所示:
Sub DrawPoints() '绘制点
Dim arr() As Double '定义一个空的动态数组
Dim arraylen As Integer
pointsStr = "1, 1, 2, 2, 3, 3, 4, 4"
splitStr = ","
pointsResults = Split(pointsStr, splitStr)
arraylen = UBound(pointsResults)'数组维度
ReDim arr(0 To arraylen) As Double '重新定义动态数组
For i = 0 To arraylen
arr(i) = Val(pointsResults(i))
Next i
ThisDrawing.ModelSpace.AddLightWeightPolyline arr '绘制多段线
End Sub
4.2.绘制圆
源码如下所示:
Function DrawCircle(circleText As String) As Integer
textlen = Len(circleText)
startIndex = InStr(1, circleText, "(") '字符串编码序号从1开始
endIndex = InStrRev(circleText, ")")
textDst = Mid(circleText, startIndex + 1, endIndex - startIndex - 1)
splitStr = ","
rlts = Split(textDst, splitStr)
ReDim pt(0 To 2) As Double '中心点
pt(0) = Val(rlts(0))
pt(1) = Val(rlts(1))
ThisDrawing.ModelSpace.AddCircle pt, 2
End Function
4.3.绘制多个多边形
Function DrawPoints(polyText) '多边形
Dim arr() As Double '定义一个空的动态数组
Dim arraylen As Integer
pointsStr = polyText
splitStr = ","
pointsResults = Split(pointsStr, splitStr)
arraylen = UBound(pointsResults)
ReDim arr(0 To arraylen) As Double '重新定义动态数组
For i = 0 To arraylen
arr(i) = Val(pointsResults(i))
Next i
ThisDrawing.ModelSpace.AddLightWeightPolyline arr
'起点
ReDim circleCenterPoint(0 To 2) As Double '中心点
circleCenterPoint(0) = Val(pointsResults(0))
circleCenterPoint(1) = Val(pointsResults(1))
ThisDrawing.ModelSpace.AddCircle circleCenterPoint, 0.5
'起点
ReDim circleCenterPoint2(0 To 2) As Double '中心点
circleCenterPoint2(0) = Val(pointsResults(2))
circleCenterPoint2(1) = Val(pointsResults(3))
ThisDrawing.ModelSpace.AddCircle circleCenterPoint2, 1
End Function
Function readTextIntoExcel(path As String)
text = ""
Open path For Input As #1 '
Do While Not EOF(1) '
Line Input #1, currLine
text = text + currLine
Loop
Close #1
readTextIntoExcel = text
End Function
Sub DrawPolys()
polysStr = readText("C:/Users/ajz/Desktop/vba.txt")
splitStr = ";"
polysResults = Split(polysStr, splitStr)
polyslen = UBound(polysResults)
For i = 0 To polyslen
DrawPoints (polysResults(i))
Next i
End Sub
5.函数过程调用
一、在同一个文件调用同一个模块名中的函数和过程 1、addFun 5,3 2、Call addFun(5,3) 3、Run “addFun”,5,3 二、在同一个文件调用不同模块名中的函数和过程 1、模块名字.addFun 5,3 2、Call 模块名字.addFun(5,3) 3、Run “模块名字.addFun”,5,3
6.画文字 6.1.绘制文字源码如下所示:
Function DrawCADText(dstText As String, pointText As String, textHeight As Single) As Integer
textlen = Len(pointText)
startIndex = InStr(1, pointText, "(") '字符串编码序号从1开始
endIndex = InStrRev(pointText, ")")
textDst = Mid(pointText, startIndex + 1, endIndex - startIndex - 1)
splitStr = ","
rlts = Split(textDst, splitStr)
ReDim pt(0 To 2) As Double '中心点
pt(0) = Val(rlts(0))
pt(1) = Val(rlts(1))
ThisDrawing.ModelSpace.AddText dstText, pt, textHeight
End Function
Sub Run()
Call DrawCADText("538", "(1585.0989583333333, -3591.5104166666665)", 7)
End Sub
6.2.CAD设置文字字体
命令行输入ST,弹出下图所示: 新建合适的样式,设置字体样式。然后选择目标对象,右键选择特性,或者双击目标对象,如下图所示;
在命令行输入units,然后弹出如下图所示:
显示画图区域,点击范围缩放,如下图所示:
如有疑问,敬请留言。