- 积分
- 1285
- 明经币
- 个
- 注册时间
- 2002-8-13
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
本帖最后由 作者 于 2003-4-6 3:41:05 编辑
pt1(0) = X1: pt1(1) = Y1: pt1(2) = 0
pt2(0) = X2: pt2(1) = Y2: pt2(2) = 0
Dim dist As Variant
dist = Text3.Text
Angle = acadObj.ActiveDocument.Utility.AngleFromXAxis(pt1, pt2)
Angle = Angle + pi / 2
xpt1 = acadObj.ActiveDocument.Utility.PolarPoint(pt1, Angle, dist)
xpt2 = acadObj.ActiveDocument.Utility.PolarPoint(pt2, Angle, dist)
xpt3 = acadObj.ActiveDocument.Utility.PolarPoint(pt2, Angle, -dist)
xpt4 = acadObj.ActiveDocument.Utility.PolarPoint(pt1, Angle, -dist)
''创建选择集
Dim ssetobj As AcadSelectionSet
On Error Resume Next
Set ssetobj = acadObj.ActiveDocument.SelectionSets("ss")
If Err Then Set ssetobj = acadObj.ActiveDocument.SelectionSets.Add("ss")
ssetobj.Clear
''选择实体
Dim filtertype As Variant
Dim filterdata As Variant
Dim fType(0) As Integer
Dim fData(0) As Variant
Dim pickedobjs As AcadEntity
Dim xpt(0 To 11) As Double
fType(0) = 0
fData(0) = "text"
filtertype = fType
filterdata = fData
xpt(0) = xpt1(0)
xpt(1) = xpt1(1)
xpt(2) = xpt1(2)
xpt(3) = xpt2(0)
xpt(4) = xpt2(1)
xpt(5) = xpt2(2)
xpt(6) = xpt3(0)
xpt(7) = xpt3(1)
xpt(8) = xpt3(2)
xpt(9) = xpt4(0)
xpt(10) = xpt4(1)
xpt(11) = xpt4(2)
ssetobj.SelectByPolygon acSelectionSetCrossingPolygon,xpt,filtertype,filterdata
''遍历选择集
For Each pickedobjs In ssetobj
retpt = pickedobjs.InsertionPoint
rettxt = pickedobjs.TextString
Write #2, rettxt, retpt(0), retpt(1), retpt(2)
Next
''删除选择集
ssetobj.Delete
小弟学VB不久,以上代码是用VB做的选择集问题,但为什么每次读入文件中的TEXT不全呢??并且每次结果都不同,希望老大帮忙分析一下。
还有一个问题就是已知一点和一直线两端点坐标,除了数学方法外,VBA中有无简单方法求点到直线的距离?? |
|