|
|
Sub cadtoxls()
Dim ExcelApp As Excel.Application
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err 0 Then
Set ExcelApp = CreateObject("Excel.Applicationn")
End If
Set xlsheet = ExcelApp.ActiveWorkbook.Sheets("数据输入") 'excel通讯
Dim Ent As AcadEntity, TextEnt As AcadMText
' Dim TextToExcel As AcadMText
Dim pp As Variant
Dim p(0 To 2) As Double '定义坐标变量
Dim p2(0 To 2) As Double
Dim p3(0 To 2) As Double
Dim p4(0 To 2) As Double
p(0) = 310.77: p(1) = 42: p(2) = 0 '坐标赋值
p2(0) = 353.56: p2(1) = 42: p2(2) = 0
p3(0) = 336.33: p3(1) = 10.44: p3(2) = 0
p4(0) = 367.08: p4(1) = 17.98: p4(2) = 0
For Each Ent In ThisDrawing.PaperSpace '循环实体
Select Case Ent.ObjectName '获取实体名
Case "AcDbMText" '选择文本实体
Set TextEnt = Ent
pp = TextEnt.InsertionPoint
If pp(0) = p(0) And pp(1) = p(1) Then
dz1 = TextEnt.TextString
ElseIf pp(0) = p2(0) And pp(1) = p2(1) Then
bb = TextEnt.TextString
For aa = 1 To Len(bb)
If IsNumeric(Mid(bb, aa, 1)) Then Exit For
Next aa
ElseIf pp(0) = p3(0) And pp(1) = p3(1) Then
xz1 = TextEnt.TextString
End If
End Select
Next Ent
mz1 = CStr(Left(bb, aa - 1))
hm1 = CStr(Right(bb, Len(bb) - aa + 1))
dzxz1 = dz1 & xz1
xlsheet.Cells(1, 2) = mz1
xlsheet.Cells(5, 2) = dzxz1
xlsheet.Cells(15, 2) = hm1
End Sub
请问为什么我在 P 点写MTEXT时，用自动捕捉插入点时，dz1显示不出来
而用手写输入插入点310.77,42,0 dz1却可以识别呢？
本帖以下内容被隐藏保护；需要你回复后，才能看到！ 游客，如果您要查看本帖隐藏内容请 回复 |
|
置顶卡
