先祝大家元旦快乐。然后求助，感觉一句话说不太清楚，请大神看帖子内详述，谢谢

半个月亮

麻烦大神先看图

原始图。目的是：1、在每一个端点或交点画且只画一个圆。2、并根据两线段的夹角(一条线段与另一条线段的反向延长线的夹角，如图)来添加圆旁边的注释。3、在端点或有夹角的交点处，给每条线段添加一个块，角度为线段的延长线方向。(不知道有没有说清楚。。。)
              夹角

完成图-理想中


完成图-现实中  1、画圆已实现。2、园旁边的注释我设置的全部一样。。。3、插入的块，我在线段角度及线段角度+180度的方向上都插入了一个，然后手动把没用的删掉。


感觉2-3实现的好笨，恳请大神指点迷津，万分感激！

雪山飞狐_lzh

你的问题是：不会判断某点的前后两点相对于该点反向延长线方向？

半个月亮

雪山飞狐_lzh 发表于 2016-1-2 17:13
你的问题是：不会判断某点的前后两点相对于该点反向延长线方向？

嗯，如果只有两条线段，或者线段顺序是跟选择集中顺序相同的话，我知道怎么判断角度。问题是线段顺序可能不连续，比如最后一张图中，1#-2#-3#等序号就是按选择集中顺序标注的

半个月亮

3、插入块的时候，如果按照线段的角度两端插入，就会是这样

我是再按照线段角度+180度的方向再插入一次，就变成了

然后我再删掉不需要的，就变成了最后想要的样子

有没有办法一步到位呢

雪山飞狐_lzh

你可以把点放在第一个数组里
第二个数组放该点对应的直线集合比如
arr1：p1，p2...
arr2：（line1，line2），（line2，line3）...
然后遍历对应点和相应直线插入块

半个月亮

雪山飞狐_lzh 发表于 2016-1-2 19:18
你可以把点放在第一个数组里
第二个数组放该点对应的直线集合比如
arr1：p1，p2...

不好意思，我刚接触vba，能说详细点吗？
我已经把所有线段的起点和终点坐标放进一个数组了，并比较标记了重复点
直线集合数组应该是什么结构呢？定义完后应该怎么操作？谢谢

雪山飞狐_lzh

声明为object数组
先用for循环对数组元素设初值为集合

半个月亮

雪山飞狐_lzh 发表于 2016-1-2 21:14
声明为object数组
先用for循环对数组元素设初值为集合

版主你好，受你的启发，第二个功能(根据角度添加注释)已经实现，谢谢！但我没有用object数组（主要是不会用）
现在只剩下第三个功能了，绞尽脑汁也想不出解决办法，主要是不知道如何判断什么时候使用线段本身角度，什么时候将线段角度+180度，求指教，不胜感激

半个月亮

有没有办法判断插入的块是否跟线段重合呢

雪山飞狐_lzh

前面获取点的部分代码，后面的代码你自己接上吧
Sub tt()
On Error Resume Next
    Dim ss As AcadSelectionSet
    ThisDrawing.SelectionSets("TlsTest").Delete
    Set ss = ThisDrawing.SelectionSets.Add("TlsTest")
    Dim ft(0) As Integer, fd(0)
    ft(0) = 0: fd(0) = "line"
    ss.SelectOnScreen ft, fd
   
    Dim pts()
    Dim lines() As Collection
   
    Dim id As Integer
    Dim line As AcadLine
    For i = 0 To ss.Count - 1
        Set line = ss(i)
        AddPoint pts, lines, line.StartPoint, line
        AddPoint pts, lines, line.EndPoint, line
    Next i

End Sub

Sub AddPoint(ByRef pts(), ByRef lines() As Collection, pt, line)
On Error Resume Next
    Dim n As Integer
    Dim id As Integer
    n = UBound(pts)
    If Err Then n = -1
    For i = 0 To n
        If (pts(i)(0) - pt(0)) ^ 2 + (pts(i)(1) - pt(1)) ^ 2 < 0.00000001 Then
            lines(i).Add line
            Exit Sub
        End If
    Next i
   
    n = n + 1
    ReDim Preserve pts(n)
    ReDim Preserve lines(n)
    pts(n) = pt
    Set lines(n) = New Collection
    lines(n).Add line
   
End Sub