如何把cad表格转换与excel表格

Question

如题所述

Answer 1

用vba可以实现。
为了防止信息干扰，建议在读取前，将表格内容设置在一个图层（例如100）中。
下面的代码是帮朋友做的，仅供参考。
Sub 读取信息()
' Const tzz = 6 'x坐标相差5认为是同一列数据
Dim ent As AcadEntity '对象基类
Dim A(1 To 1000, 1 To 4) '1-文本 2-x坐标 3-y坐标 4-数据项的列数(4-修正后的X坐标)
Dim I As Integer
Dim x(1 To 1000) As Double '存放CAD表格线段X坐标值
Dim xCount As Integer
Dim lineCount As Integer
Dim startP As Variant
Dim endP As Variant
Dim lineS(1 To 1000, 1 To 4) '记录竖线坐标
I = 1: j = 1
For Each ent In ThisDrawing.ModelSpace '所有对象
If TypeOf ent Is AcadText And ent.Layer = "100" Then '单行文本 且图层100

A(I, 1) = ent.TextString
B = ent.InsertionPoint
A(I, 2) = B(0)
A(I, 3) = B(1)

I = I + 1
'Else If TypeOf ent Is AcadMText Then '多行文本

'ElseIf TypeOf ent Is AcadDimension Then ‘标注
Else
If TypeOf ent Is AcadLine And ent.Layer = "100" Then
startP = ent.StartPoint
endP = ent.EndPoint

' x1 = ent.StartPoint(0)
' x2 = ent.EndPoint(0)
' If startP(0) >= 1507 Then
' sss = 1
' End If
If Abs(startP(0) - endP(0)) <= 0.1 Then '起点X坐标=终点X坐标
x(j) = startP(0)
lineS(j, 1) = startP(0)
lineS(j, 2) = startP(1)
lineS(j, 3) = endP(0)
lineS(j, 4) = endP(1)

j = j + 1
End If
End If
End If
Next
I = I - 1: j = j - 1
lineCount = j
'对线段X坐标值排序
For k = 1 To j - 1
For l = k + 1 To j
If x(k) > x(l) Then
xx = x(k)
x(k) = x(l)
x(l) = xx
End If
Next l
Next k

'对读取文本的X坐标进行排序
Dim m_1 As String
Dim m_2 As Double
Dim m_3 As Double
Dim m_4 As Double
For j = 1 To I - 1
For k = j + 1 To I
If A(j, 2) > A(k, 2) Then '数据交换
m_1 = A(j, 1)
m_2 = A(j, 2)
m_3 = A(j, 3)
A(j, 1) = A(k, 1)
A(j, 2) = A(k, 2)
A(j, 3) = A(k, 3)
A(k, 1) = m_1
A(k, 2) = m_2
A(k, 3) = m_3

End If
Next k

Next j
'去除重复值
Dim y(1 To 100)
l = 1: y(1) = x(1)
For k = 2 To lineCount
If x(k) - y(l) > 1 Then
l = l + 1
y(l) = x(k)
End If
Next k
xCount = l

''设定X2坐标值 x坐标差值小于调整值则认为是同一列数据，将X2坐标设置为相同值
'A(1, 4) = Int(A(1, 2))
'For j = 2 To I
' If A(j, 2) - A(j - 1, 2) < tzz Then
' A(j, 4) = A(j - 1, 4)
' Else
' A(j, 4) = Int(A(j, 2))
' End If
'Next j
'根据X坐标值计算数据项的列号
For k = 1 To I
For l = 1 To xCount
If A(k, 2) >= y(l) And A(k, 2) < y(l + 1) Then
A(k, 4) = l
Exit For
End If
Next l
Next k
'对Y坐标进行降序排列
For j = 1 To I - 1
For k = j + 1 To I
If A(j, 3) < A(k, 3) And A(j, 4) = A(k, 4) Then '数据交换
m_1 = A(j, 1)
m_2 = A(j, 2)
m_3 = A(j, 3)
m_4 = A(j, 4)
A(j, 1) = A(k, 1)
A(j, 2) = A(k, 2)
A(j, 3) = A(k, 3)
A(j, 4) = A(k, 4)
A(k, 1) = m_1
A(k, 2) = m_2
A(k, 3) = m_3
A(k, 4) = m_4
End If
Next k

Next j

Set xlApp = GetObject(, "Excel.Application")
If Err Then
MsgBox " Excel 应用程序没有运行。请启动 Excel 并重新运行程序。"
Exit Sub
End If
Dim xlSheet As Worksheet
Set xlSheet = xlApp.ActiveSheet
xlSheet.Select

For j = 1 To I - 1
With xlSheet
.Cells(j + 1, 1) = A(j, 1)
.Cells(j + 1, 2) = A(j, 2)
.Cells(j + 1, 3) = A(j, 3)
.Cells(j + 1, 4) = A(j, 4)
End With
Next j
'将竖线的坐标值输出
For j = 1 To lineCount
With xlSheet
.Cells(j + 1, 11) = lineS(j, 1)
.Cells(j + 1, 12) = lineS(j, 2)
.Cells(j + 1, 13) = lineS(j, 3)
.Cells(j + 1, 14) = lineS(j, 4)

End With
Next j

j = 1
End Sub

Answer 2

不行的。

Answer 3

我有cad表格与excel表格互转的破解版软件，支持32和64位系统，带有破解文件，可以永久使用的本回答被提问者采纳

Answer 4

这么做的目的是啥？