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

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

<p>代码如下：</p><p>QD = acadDoc.Utility.GetPoint(, "起点：")<br/>ZD = acadDoc.Utility.GetPoint(, "终点：")<br/>&nbsp;&nbsp;&nbsp; Set lineObj = acadDoc.ModelSpace.AddLine(QD, ZD)<br/>&nbsp;&nbsp;&nbsp; Set SelSetLineObject = acadDoc.SelectionSets.Add("AA") <br/>&nbsp;&nbsp;&nbsp; SelSetLineObject.Select acSelectionSetCrossing, QD, ZD<br/>&nbsp;&nbsp;&nbsp; InsertTextPoint = acadDoc.Utility.GetPoint(, vbCr &amp; "插入点：")<br/>&nbsp;&nbsp;&nbsp; intPoints(0) = InsertTextPoint(0)<br/>&nbsp;&nbsp;&nbsp; intPoints(1) = InsertTextPoint(1)</p><p>For index = 0 To SelSetLineObject.Count - 1<br/>&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set e = SelSetLineObject.Item(index)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If e.ObjectName = lineObj Then <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt1 = e.StartPoint&nbsp; ' 直线起点坐标&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt1 = e.EndPoint&nbsp;&nbsp;&nbsp; ' 直线终点坐标 <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set TextObject = acadDoc.ModelSpace.AddText(pt1, InsertPoint，1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>SelSetLineObject.Delete</p><p>图上有若干条直线，有平行有交叉，我从QD点到ZD点画一条穿过这几条线的直线，然后在指定点按照从QD点到交叉点由近到远的顺序依次插入图上原有直线两端的坐标，我上面的代码只能无顺序插入，麻烦那位大哥帮我改一下！</p>

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

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

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

<p><strong><font color="#000000">请教mccad，在VBA中能否调用或实现ARX中的</font></strong><strong><font color="#000000">“Getpointbydistance”函数功能？</font></strong></p>

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

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

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

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

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

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

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

我对这个不是很熟，能不能给点代码？
页: [1]
查看完整版本: [求助]帮我修改一下这段代码