AutoCad-查看坐标数据-画多段线命令-画圆命令-画文字-VBA

admin管理员组

文章数量:1604751

文章目录

• • 1.打开VBA
  • 2.动作录制
  • 3.显示坐标
  • 4.VBA宏
  • • 4.1.绘制多段线
    • 4.2.绘制圆
    • 4.3.绘制多个多边形
  • 5.函数过程调用
  • 6.画文字
  • • 6.1.绘制文字
    • 6.2.CAD设置文字字体
    • 6.3.CAD设置单位
  • 7.范围缩放
  • 8.作者答疑

本文在AutoCAD 2016环境下测试。

1.打开VBA

菜单栏 管理》Visual Basic 编辑器。

如果提示缺少VBA模块，官网下载。下载安装完毕，打开如下图所示：

常见的VBA界面。

2.动作录制

由于录制的动作，不能用于脚本编辑，笔者认为作用不是很大。

3.显示坐标

点击右下角的设置图标，然后点击勾选坐标选项。

4.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，弹出下图所示：

新建合适的样式，设置字体样式。然后选择目标对象，右键选择特性，或者双击目标对象，如下图所示;

6.3.CAD设置单位

在命令行输入units，然后弹出如下图所示：

7.范围缩放

显示画图区域，点击范围缩放，如下图所示：

8.作者答疑

如有疑问，敬请留言。

本文标签： 命令坐标文字数据AutoCAD