- 积分
- 795
- 明经币
- 个
- 注册时间
- 2017-9-7
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
我初学VBA,在cad2014的vba编辑器中编了一个过程,计划实现的功能是从屏幕中选择单文本对象和多线段对象到选择集中,再在选择集中遍历所有对象,找到多线段对象和单文本对象,在单文本对象中提取文字内容和坐标,但出现问题如下:
明明看到ent.InsertionPoint有三个坐标值,但使用ent.InsertionPoint(0)为什么不能取到X坐标值?
代码如下:
Public Sub GetAreaAndName()
'得到多线段的面积和文本对象内部的文字和坐标
'新建选择集
Dim ssetObj As AcadSelectionSet
Set ssetObj = ThisDrawing.SelectionSets.Add("aaz")
'从屏幕中选择文本对象和多线段对象
Dim ftype(0 To 3) As Integer
Dim fdata(0 To 3) As Variant
ftype(0) = -4: fdata(0) = "<OR"
ftype(1) = 0: fdata(1) = "TEXT" '"text" '
ftype(2) = 0: fdata(2) = "LWPOLYLINE" ' "polyline" '
ftype(3) = -4: fdata(3) = "OR>"
Dim nPolylineCount As Integer '多线段的数量
Dim nTextCount As Integer '文本对象的数量
Dim filtertype, filterdata As Variant
filtertype = ftype: filterdata = fdata
ssetObj.SelectOnScreen filtertype, filterdata
'统计多线段对象和文本对象的数量
nPolylineCount = 0: nTextCount = 0
For Each opickedobjs In ssetObj
If opickedobjs.ObjectName = "AcDbText" Then nTextCount = nTextCount + 1 '得到文本对象的数量
If opickedobjs.ObjectName = "AcDbPolyline" Then nPolylineCount = nPolylineCount + 1 '得到多线段对象的数量
Next
'分别得到多线段的对象ID、面积和文本对象的ID、内容和坐标
Dim GetPoly() As Variant '多线段对象ID,面积,文字1,文字2,文字3
Dim GetText() As Variant '文本对象ID,内容,X座标,y座标
ReDim GetPoly(0 To nPolylineCount - 1, 0 To 4)
ReDim GetText(0 To nTextCount - 1, 0 To 3)
nP = 0: nT = 0
For Each ent In ssetObj
If ent.ObjectName = "AcDbPolyline" Then
GetPoly(nP, 0) = pickedobjs.ObjectID '得到对象ID
GetPoly(nP, 1) = pickedobjs.Area '得到对象面积
nP = nP + 1
End If
If ent.ObjectName = "AcDbText" Then
GetText(nT, 0) = ent.ObjectID '得到对象ID
GetText(nT, 1) = ent.TextString '得到对象的文本内容
GetText(nT, 2) = ent.InsertionPoint(0) '得到X坐标
GetText(nT, 3) = ent.InsertionPoint(1) '得到Y坐标
nT = nT + 1
End If
Next
ssetObj.Delete
End Sub
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?注册
x
|