- UID
- 78250
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2003-9-9
- 最后登录
- 1970-1-1
|
发表于 2004-11-12 08:39:18
|
显示全部楼层
以前在VB中写过的一个函数,应该是你要的功能
Public Function BorderPoint(ByVal SelDoc As AcadDocument, ByVal SelPoint As Variant) As Variant
'按些定点返回边界,有边界时返回边界点集和,无边界返加0
Dim n As Long, i As Integer, m As Integer
Dim lwpLineObj As AcadLWPolyline
Dim explodedObjects As Variant
Dim explodedLine As AcadLine
Dim Point() As Double
Dim Border() As Double
n = SelDoc.ModelSpace.Count
' 调用BOUNDARY命令获取某一点处的边界
SelDoc.SendCommand "_-Boundary" & vbCr & SelPoint(0) & "," & SelPoint(1) & vbCr & vbCr
' 如果存在边界,则会生成新的实体
If SelDoc.ModelSpace.Count > n Then
Set lwpLineObj = SelDoc.ModelSpace.Item(SelDoc.ModelSpace.Count - 1)
Else
MsgBox "未发现有效的板材边界!", vbExclamation + vbOKOnly, "系统提示"
BorderPoint = 0
Exit Function
End If
'取出边界线
explodedObjects = lwpLineObj.Explode
lwpLineObj.Delete
ReDim Point((UBound(explodedObjects) + 1) * 6 - 1)
ReDim Border((UBound(explodedObjects) + 1) * 3 - 1)
For n = 0 To UBound(explodedObjects)
If explodedObjects(n).ObjectName <> "AcDbLine" Then
MsgBox "当前所选取板材边界错误,请重选!", vbExclamation + vbOKOnly, "系统提示"
BorderPoint = 0
GoTo 100
End If
Set explodedLine = explodedObjects(n)
Point(n * 6 + 0) = explodedLine.StartPoint(0)
Point(n * 6 + 1) = explodedLine.StartPoint(1)
Point(n * 6 + 2) = explodedLine.StartPoint(2)
Point(n * 6 + 3) = explodedLine.EndPoint(0)
Point(n * 6 + 4) = explodedLine.EndPoint(1)
Point(n * 6 + 5) = explodedLine.EndPoint(2)
Next
'算出边界点
i = 0
Border(0) = Point(0)
Border(1) = Point(1)
Border(2) = Point(2)
For n = O To (UBound(Point) + 1) / 3 - 1
For i = 0 To m
If Border(i * 3 + 0) = Point(n * 3 + 0) And Border(i * 3 + 1) = Point(n * 3 + 1) And Border(i * 3 + 2) = Point(n * 3 + 2) Then
Exit For
End If
Next
If i = m + 1 Then
Border(i * 3 + 0) = Point(n * 3 + 0)
Border(i * 3 + 1) = Point(n * 3 + 1)
Border(i * 3 + 2) = Point(n * 3 + 2)
m = m + 1
End If
Next
BorderPoint = Border
'删除边界线
100:
For n = 0 To UBound(explodedObjects)
explodedObjects(n).Delete
Next
End Function |
|