代码如下: 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点到交叉点由近到远的顺序依次插入图上原有直线两端的坐标,我上面的代码只能无顺序插入,麻烦那位大哥帮我改一下! |