明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1374|回复: 0

求助:我在cad08或06里画的多段线怎么不支持对象

[复制链接]
发表于 2009-4-14 21:26:00 | 显示全部楼层 |阅读模式
本帖最后由 作者 于 2009-4-24 13:18:01 编辑

Sub toudu()
Dim pl(7) As Double

pt(2) as Double
Dim plineObj As AcadLWPolyline
pl(0) = 5.6811
pl(1) = 0
pl(2) = -5.6811
pl(3) = 0
pl(4) = -5.6811
pl(5) = 0
pl(6) = 5.6811
pl(7) = 0
Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(pl)
plineObj.SetBulge 0, 1.72677826
plineObj.SetBulge 1, 0
dim q as Double
   pt(0) = 4.470
   pt(1) = 7.921
   pt(2) = 0

q = DistancePt2Poly(pt1, plineObj)‘调用明经的点到多段线的最短距离
    MsgBox "点到多段线的最近距离是:" & q

end sub

Private Function DistancePt2Poly(ByVal pt As Variant, ByVal objPoly As AcadLWPolyline) As Double
    Dim intVertCount As Integer         ' 多段线的顶点数量
    Dim varCoords As Variant            ' 保存所有顶点的坐标数组
    varCoords = objPoly.Coordinates
    intVertCount = (UBound(varCoords) + 1) / 2
   
    ' 遍历所有顶点,判断每一段曲线与点之间的距离
    Dim i As Integer
    Dim ptCurrent As Variant, ptNext As Variant     ' 当前顶点和下一个顶点
    Dim minDistance As Double                          ' 最短距离
    For i = 0 To intVertCount - 1
        ' 获得当前顶点和下一个顶点的坐标
        If i < intVertCount - 1 Then
            ptCurrent = objPoly.Coordinate(i)
            ptNext = objPoly.Coordinate(i + 1)
        ElseIf objPoly.Closed Then
            ptCurrent = objPoly.Coordinate(i)
            ptNext = objPoly.Coordinate(0)
        Else
            Exit For
        End If
       
        ' 分情况计算距离
        If objPoly.GetBulge(i) = 0 Then     ' 如果该段是直线
            If i = 0 Then
                minDistance = DisPt2Line(pt, ptCurrent, ptNext)
            Else
                If DisPt2Line(pt, ptCurrent, ptNext) < minDistance Then
                    minDistance = DisPt2Line(pt, ptCurrent, ptNext)
                End If
            End If
        Else
            Dim aimPoly As AcadLWPolyline   ' 辅助多段线
            Dim ptVerts(0 To 3) As Double   ' 辅助多段线的顶点
            Dim varEnts As Variant          ' 分解辅助多段线后得到的实体
            Dim aimArc As AcadArc           ' 辅助圆弧
            ptVerts(0) = ptCurrent(0)
            ptVerts(1) = ptCurrent(1)
            ptVerts(2) = ptNext(0)
            ptVerts(3) = ptNext(1)
            Set aimPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(ptVerts)
            aimPoly.SetBulge 0, objPoly.GetBulge(i)
           
            ' 分解辅助多段线,得到一个圆弧
            varEnts = aimPoly.Explode
            If TypeOf varEnts(0) Is AcadArc Then
                Set aimArc = varEnts(0)
            End If
           
            ' 计算点到圆弧段的距离
            If i = 0 Then
                minDistance = DisPt2Arc(pt, aimArc)
            Else
                If DisPt2Arc(pt, aimArc) < minDistance Then
                    minDistance = DisPt2Arc(pt, aimArc)
                End If
            End If
           
            ' 删除辅助圆弧和多段线
            aimPoly.Delete
            aimArc.Delete
        End If
    Next i
   
    DistancePt2Poly = minDistance
End Function

' 计算点到直线的最短距离
Private Function DisPt2Line(ByVal pt As Variant, ByVal ptStart As Variant, _
                            ByVal ptEnd As Variant) As Double
    ' 计算三点所组成的三角形的面积s=sqr(p*(p-a)*(p-b)*(p-c)),p=0.5*(a+b+c)
    Dim area As Double
    Dim p As Double         ' 周长的一半
    Dim a As Double, b As Double, c As Double       ' 各条边的边长
    a = Distance(pt, ptStart)
    b = Distance(pt, ptEnd)
    c = Distance(ptStart, ptEnd)
    p = (a + b + c) / 2
    area = Sqr(p * (p - a) * (p - b) * (p - c))
   
    ' 计算点到直线的垂直距离
    Dim dblDistance As Double
    dblDistance = 2 * area / c
   
    ' 计算垂足到直线两端点的距离
    Dim dblDis1 As Double, dblDis2 As Double
    dblDis1 = Sqr(a ^ 2 - dblDistance ^ 2)
    dblDis2 = Sqr(b ^ 2 - dblDistance ^ 2)
   
    ' 根据点是否在直线两端点之间,返回点到直线的最短距离
    If dblDis1 > c Or dblDis2 > c Then
        If a > b Then
            DisPt2Line = b
        Else
            DisPt2Line = a
        End If
    Else
        DisPt2Line = dblDistance
    End If
End Function

' 计算点到圆弧的最短距离
Private Function DisPt2Arc(ByVal pt As Variant, ByVal objArc As AcadArc) As Double
    ' 假设点在圆弧的扇形区域内,返回点到圆弧的距离
    DisPt2Arc = Distance(pt, objArc.Center) - objArc.Radius
   
    ' 计算点到圆弧两个端点的距离
    Dim dblDis1 As Double, dblDis2 As Double
    dblDis1 = Distance(pt, objArc.StartPoint)
    dblDis2 = Distance(pt, objArc.EndPoint)
   
    ' 如果点不在圆弧的扇形区域内,则到两端点的距离包含了一个最小距离
    Dim angle As Double         ' 圆心到点的矢量的角度
    angle = ThisDrawing.Utility.AngleFromXAxis(objArc.Center, pt)
    Dim angleStart As Double, angleEnd As Double
    angleStart = objArc.StartAngle
    angleEnd = objArc.EndAngle
    If (angle - angleStart) * (angle - angleEnd) * (angleEnd - angleStart) > ZERO Then
        If dblDis1 > dblDis2 Then
            DisPt2Arc = dblDis2
        Else
            DisPt2Arc = dblDis1
        End If
    End If
End Function

' 计算两点之间的距离
Private Function Distance(ByVal pt1 As Variant, ByVal pt2 As Variant) As Double
    Distance = Sqr((pt1(0) - pt2(0)) ^ 2 + (pt1(1) - pt2(1)) ^ 2)
End Function

' 测试本节的函数
Sub GetDistancePt2Poly()
    Dim pt As Variant
    pt = ThisDrawing.Utility.GetPoint(, "拾取一点:")

    Dim objPoly As AcadLWPolyline
    Dim ptPick As Variant
    ThisDrawing.Utility.GetEntity objPoly, ptPick, "选择多段线:"
   
    MsgBox "点到多段线的最近距离是:" & DistancePt2Poly(pt, objPoly)
End Sub


怎么q的值是空值,要呢显示错误:(溢出)调试了好久就没有,但是在命令行用pline画一个,用哪个测试函数GetDistancePt2Poly就有了。请高手看是怎么回事?多谢

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-26 02:40 , Processed in 0.157265 second(s), 23 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表