社区 › VB › [求助]帮我修改一下这段代码

kdst 发表于 2009-8-9 03:44:00

[求助]帮我修改一下这段代码

代码如下：
QD = acadDoc.Utility.GetPoint(, "起点：")
ZD = acadDoc.Utility.GetPoint(, "终点：")
    Set lineObj = acadDoc.ModelSpace.AddLine(QD, ZD)
    Set SelSetLineObject = acadDoc.SelectionSets.Add("AA")
    SelSetLineObject.Select acSelectionSetCrossing, QD, ZD
    InsertTextPoint = acadDoc.Utility.GetPoint(, vbCr & "插入点：")
    intPoints(0) = InsertTextPoint(0)
    intPoints(1) = InsertTextPoint(1)
For index = 0 To SelSetLineObject.Count - 1

          Set e = SelSetLineObject.Item(index)
         If e.ObjectName = lineObj Then
            pt1 = e.StartPoint' 直线起点坐标         
            pt1 = e.EndPoint    ' 直线终点坐标
       Set TextObject = acadDoc.ModelSpace.AddText(pt1, InsertPoint，1)
       Next
SelSetLineObject.Delete
图上有若干条直线，有平行有交叉，我从QD点到ZD点画一条穿过这几条线的直线，然后在指定点按照从QD点到交叉点由近到远的顺序依次插入图上原有直线两端的坐标，我上面的代码只能无顺序插入，麻烦那位大哥帮我改一下！

mccad 发表于 2009-8-9 07:22:00

你这种情况需要求交点到指定点的距离。进行排序后，再操作。

xuyajun1979 发表于 2009-8-9 11:53:00

请教mccad，在VBA中能否调用或实现ARX中的“Getpointbydistance”函数功能？

雪山飞狐_lzh 发表于 2009-8-9 13:31:00

VBA没有提供相应的方法，要借助Vlax类，不过很不稳定

kdst 发表于 2009-8-10 22:22:00

是不是很难，有没有其他方法可以达到这种效果！

mccad 发表于 2009-8-10 22:37:00

不算难啊。你需要做的是:
1.求交点，用IntersectWith方法。
2.用二维数组保存直线句柄与距离。
3.用排序法对数组按距离来排序。
4.排完序后，直线就已经排好序了。

kdst 发表于 2009-8-14 01:05:00

我对这个不是很熟，能不能给点代码？

查看完整版本: [求助]帮我修改一下这段代码