关于VBA intersectwith函数如何判断是否有交点的问题
本帖最后由 heaven陌上花开 于 2019-11-22 12:20 编辑SignatureVBA:RetVal = object.IntersectWith(IntersectObject, ExtendOption)objectType: All drawing objects (except PViewport and PolygonMesh), AttributeReferenceThe objects this method applies to.IntersectObjectAccess: Input-onlyType: ObjectThe object can be one of the supported drawing objects or an AttributeReference.ExtendOptionAccess: Input-onlyType: AcExtendOption enumThis option specifies if none, one or both, of the objects are to be extended in order to attempt an intersection.
[*]acExtendNone: Does not extend either object.
[*]acExtendThisEntity: Extends the base object.
[*]acExtendOtherEntity: Extends the object passed as an argument.
[*]acExtendBoth: Extends both objects.
Return Value (RetVal)Type: Variant (array of doubles)The array of points where one object intersects another object in the drawing.==============================以上是官方帮助文件给的内容，没有交点即无返回值。帮助文件还给了一个例子
heaven陌上花开 发表于 2019-11-22 12:22
这段是官方给的代码，楼主亲测是存在bug的，不管是否有交点，vartype的返回值都为8179，而不是vbempty， ...
Private Sub DrawAltitude(ByRef Altitude() As Double)'VB输出数组要通过ByRef 引用才行，不能直接输出
ConnectAutoCAD
'获取交点并写入数组中
Dim CrossPoint As Variant
Dim pickedobjs1 As AcadEntity
Dim pickedobjs2 As AcadEntity
Dim nLWS, nLS As Integer
nLWS = CorrLineObj.Count: nLS = GuideLinesObj.Count'选中的对象个数
Dim cpnts() As Double '交点数组
' Dim Altitude() As Double '高程数组
ReDim cpnts(0 To nLWS - 1, 0 To nLS - 1, 2) As Double '定义一个三维动态数组用于存放交点坐标
ReDim Altitude(0 To nLWS - 1, 0 To nLS - 1, 2) As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim textobj As AcadText
i = 0: j = 0: k = 0
For Each pickedobjs1 In CorrLineObj
Thisdrawing.Utility.Prompt vbCrLf & (i + 1) & "/" & CorrLineObj.Count
pickedobjs1.Highlight (True) '高亮选中的实体
pickedobjs1.Update
j = 0
For Each pickedobjs2 In GuideLinesObj
pickedobjs1.Highlight (True)'高亮选中的实体
pickedobjs1.Update
CrossPoint = pickedobjs1.IntersectWith(pickedobjs2, acExtendNone) '获取交点
If VarType(CrossPoint) <> vbEmpty Then '执行计算
Thisdrawing.Utility.Prompt vbCrLf & CrossPoint(1)
Thisdrawing.Utility.Prompt vbCrLf & CrossPoint(0) & "," & CrossPoint(1) & "," & CrossPoint(2)
cpnts(i, j, 0) = CrossPoint(0)
cpnts(i, j, 1) = CrossPoint(1)
cpnts(i, j, 2) = CrossPoint(2) '交点数组
Altitude(i, j, 0) = CrossPoint(0)
Altitude(i, j, 1) = CrossPoint(1) - CDbl(HeightBaseP(1)) + HeightBaseVal
Altitude(i, j, 2) = CrossPoint(2) '高程数组
'写入高程信息
textInBasePoint(0) = CrossPoint(0)
textInBasePoint(2) = CrossPoint(2)
Set textobj = Thisdrawing.ModelSpace.AddText(CStr(Format(Altitude(i, j, 1), "0.00")), textInBasePoint, 1.5)
textobj.Rotate textInBasePoint, pi / 2'旋转90°布置
End If
j = j + 1
Next pickedobjs2
i = i + 1
Next pickedobjs1
Thisdrawing.Utility.Prompt vbCrLf & "任务已完成！"
End Sub Sub Example_IntersectWith()
' This example creates a line and circle and finds the points at
' which they intersect.
' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
' Create the circle
Dim circleObj As AcadCircle
Dim centerPt(0 To 2) As Double
Dim radius As Double
centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
radius = 1
Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
ZoomAll
' Find the intersection points between the line and the circle
Dim intPoints As Variant
intPoints = lineObj.IntersectWith(circleObj, acExtendNone)
' Print all the intersection points
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If
End Sub heaven陌上花开 发表于 2019-11-22 14:31
调试了一上午，问题终于得到解决，用Ubound（）-Lbound（）判断交点元素的个数即可，有交点时个数是2，无交 ...
IntPoint = pickedobjs1.IntersectWith(pickedobjs2, acExtendNone) '获取交点
sizeIP = UBound(IntPoint) - LBound(IntPoint) '计算交点中元素的个数，有交点时是2，无交点时-1
If CDbl(sizeIP) = 2 Then '执行计算
Thisdrawing.Utility.Prompt vbCrLf & "有交点！"
Else
Thisdrawing.Utility.Prompt vbCrLf & "无交点！"
End If heaven陌上花开 发表于 2019-11-22 12:20
这段是官方给的代码，楼主亲测是存在bug的，不管是否有交点，vartype的返回值都为8179，而不是vbempty，下面附上我自己写的代码，一直解决不了判断是否存在交点的问题，还请老铁们指点一下迷津！ 命令:
1/1
8197
1642.23981521255,1368.34718727462,0
8197
1622.23981521255,1369.00846134891,0
8197
1602.23981521255,1369.64624601929,0
8197
1582.23981521255,1370.2276116206,0
8197
1596.11481521253,1369.83037327556,0
8197
1616.11481521252,1369.20936376302,0
8197
1636.11481521252,1368.54970245987,0
任务已完成！*取消* heaven陌上花开 发表于 2019-11-22 12:29
命令:
1/1
8197
这个是有交点时的响应 heaven陌上花开 发表于 2019-11-22 12:29
这个是有交点时的响应
命令:
1/1
8197
*无效*
这个是无交点时的响应，验证了不管有无交点，intersectwith函数返回值均为8197 调试了一上午，问题终于得到解决，用Ubound（）-Lbound（）判断交点元素的个数即可，有交点时个数是2，无交点时算出来的值为-1，如果有更好的方法欢迎提出. heaven陌上花开 发表于 2019-11-22 14:35
方法比较笨，但搜索了大半天都没看到有人提出解决方案，这个方法目前是可行的，欢迎大家提出更好的解决方案
页:
[1]
2