请教一下怎么样用excel VBA把excel 表格中的线路坐标数据在CAD中画路线图并标注桩号?

请教一下怎么样用excel VBA把excel 表格中的线路坐标数据在CAD中画路线图并标注桩号?,第1张

方法是引用cad的类型库,在EXCEL VBA中自动化cad。

当然涉及到的坐标计算部分可以编写个模块,专门进行坐标计算。

有了数源祥据之后就好办,画线,标注,添加闭告文字比较容易。 画线的话用addlwpolyline方法雹态搏较好。

我有个插件,标注边坡的,用vba写的,但是不知道你那个cad版本支不支持vba了,因为cad在10版的时候好像就砍掉了vba功能。如果要在高版本的cad里面使用vba要去官网下载一个vba插件才能使用。如果你有一点vba知识的话,代码如下:

Sub 标注直线坡比()

On Error GoTo li2

Dim linepo As AcadLine

Dim point1 As Variant

Dim a As Double, b As Double, c As Double, d As Double, f As Double, e As String

Dim g As Double

Dim text1 As AcadText

f = ThisDrawing.Utility.GetReal(":请输入坡比文字高度") ' "拾取直线"

li1:

ThisDrawing.Utility.GetEntity linepo, point1, "拾取直线"

a 咐唤= linepo.StartPoint(0)

b = linepo.StartPoint(1)

c = linepo.EndPoint(0)

d = linepo.EndPoint(1)

e = "1:" & Format(Round(((Abs(a - c) / Abs(b - d))), 3), "0.000")

point1(0) = (a + c) / 2

point1(1) = (b + d) / 2

point1(2) = 0

Set text1 = ThisDrawing.ModelSpace.AddText(e, point1, f)

    If linepo.Angle > 90 / 180 山拦* 3.141592654 And linepo.Angle < 270 / 180 * 逗简胡3.141592654 Then

    text1.Rotation = linepo.Angle + 3.141592654

    Else

    text1.Rotation = linepo.Angle

    End If

text1.Alignment = acAlignmentCenter

text1.TextAlignmentPoint = point1

GoTo li1

li2: MsgBox "OK!!!"

End Sub

当按下esc键或出现错误的时候(比如你没有选中直线),错误处理就强制结束,绘图就完了。

首先你要会基本的cad编程啊 画线的代码 帮助里面都有了!

随便给你找一个

直线是 AutoCAD

中最基本的对象。用户可以创建各种直线—单一直线、带圆弧和不带圆弧的多线段。通常,可以通过指定坐标点数态来绘制直线。默认线型是

CONTINUOUS(即连续的线),但还有许多线型使用点和短划。

要创建直线,春没请使用以下方法之一:

AddLine

通过两点创建直线。

AddLightweightPolyline

从顶点列表创建二维优化多段线。

AddMLine

创建多线。

AddPolyline

创建二维或三维多段线。

标准直线和多线都是在世界坐标系的 XY 平薯森源面上创建的,而多段线与优化多段线则是在对象坐标系 (OCS) 中创建的。关于转换 OCS 坐标的信息,请参见转换坐标。

本例使用

AddLightweightPolyline 方法创建一条分为两段的简单多段线,其端点坐标值分别是 (2,4)、(4,2) 和 (6,4)。

Sub Ch4_AddLightWeightPolyline()

Dim plineObj As AcadLWPolyline

Dim points(0 To 5) As Double

' 定义二维多段线的点

points(0) = 2: points(1) = 4

points(2) = 4: points(3) = 2

points(4) = 6: points(5) = 4

' 在模型空间中创建一个优化多段线对象

Set plineObj = ThisDrawing.ModelSpace. _

AddLightWeightPolyline(points)

ThisDrawing.Application.ZoomAll

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址:https://54852.com/yw/12406479.html

(0)
打赏 微信扫一扫微信扫一扫 支付宝扫一扫支付宝扫一扫
上一篇 2023-05-23
下一篇2023-05-23

发表评论

登录后才能评论

评论列表(0条)

    保存