调用Excel数据在AutoCAD中绘弯矩轴力图
' 奉献用VBA编写的AutoCAD调用Excel数据绘制弯矩轴力图。' 这个一个原始的版本的框架，代码不全，但是核心的部分，给喜欢的小伙伴们一个绘图思路。
' w.gang.89@foxmail.com
Sub draw_mn()
Dim xlsPath As String
Dim xlsApp As Excel.Application
Dim xlsBook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet
Dim endCell As Range, endLine As Long
Dim lineObj As AcadLine, plineObj As AcadPolyline, textObj As AcadText
Dim points1() As Double, points2() As Double, pCount As Integer
Dim startPoint(0 To 2) As Double, endPoint(0 To 2) As Double
Dim txt() As String, isDraw() As Integer, tH As Double, xOff As Double
xlsPath = "D:\tunnel\flac3d\h347\result.xlsx"
tH = 0.8
xOff = 30
yOff = 30
Set xlsApp = New Excel.Application
Set xlsBook = xlsApp.Workbooks.Open(xlsPath)
Set xlsSheet = xlsBook.Worksheets("Sheet1")
Set endCell = xlsSheet.Range("A1").End(xlDown)
endLine = endCell.Row
pCount = (endLine - 1) * 3
ReDim points1(0 To pCount - 1)
ReDim points2(0 To pCount - 1)
ReDim txt(0 To endLine - 2)
ReDim isDraw(0 To endLine - 2)
k = 0
For i = 2 To endLine
points1(k) = xlsSheet.Cells(i, 1)
points1(k + 1) = xlsSheet.Cells(i, 2)
points1(k + 2) = 0
'
points2(k) = xlsSheet.Cells(i, 13)
points2(k + 1) = xlsSheet.Cells(i, 14)
points2(k + 2) = 0
txt(i - 2) = xlsSheet.Cells(i, 7) / 1000#
isDraw(i - 2) = xlsSheet.Cells(i, 17)
'
k = k + 3
Next i
Set plineObj = ThisDrawing.ModelSpace.AddPolyLine(points1)
plineObj.Closed = True
Set plineObj = ThisDrawing.ModelSpace.AddPolyLine(points2)
plineObj.Closed = True
For i = 0 To k / 3 - 1
startPoint(0) = points1(i * 3)
startPoint(1) = points1(i * 3 + 1)
startPoint(2) = points1(i * 3 + 2)
endPoint(0) = points2(i * 3)
endPoint(1) = points2(i * 3 + 1)
endPoint(2) = points2(i * 3 + 2)
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
If isDraw(i) = 1 Then
Set textObj = ThisDrawing.ModelSpace.AddText(txt(i), endPoint, tH)
End If
Next i
'
'
'
'
'
'
xlsBook.Close SaveChanges:=False
xlsApp.Quit
Set xlsSheet = Nothing
Set xlsBook = Nothing
Set xlsApp = Nothing
End Sub
太牛了 点个赞 不会用啊，刚哥能不能出个傻瓜教程？
页:
[1]