[求助]请高手帮我改改这个程序
Sub example_aaa()On Error Resume Next
Dim myss As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("myss")) Then
Set myss = ThisDrawing.SelectionSets.Item("myss")
myss.detele
End If
Set myss = ThisDrawing.SelectionSets.Add("myss")
Dim mode As Integer
mode = acSelectionSetAll
myss.Select mode
Dim layerobj As AcadLayer
Set layerobj = ThisDrawing.Layers.Add("new")
layerobj.color = acRed
Dim returnobj As Object
Dim returnpnt As Variant
Dim re As Variant
ThisDrawing.Utility.GetEntity returnobj, returnpnt, "选择图像:"
MsgBox myss.count
Dim StartPoint, EndPoint
StartPoint = returnobj.StartPoint
EndPoint = returnobj.EndPoint
MsgBox "起点 " & StartPoint(0) & "," & StartPoint(1) & "," & StartPoint(2) & " 终点 " & EndPoint(0) & "," & EndPoint(1) & "," & EndPoint(2) & " name " & returnobj.ObjectName & " ID " & returnobj.ObjectID
returnobj.Layer = "new"
returnobj.Update
Dim rees(0) As AcadEntity
Set rees(0) = returnobj
myss.RemoveItems rees
MsgBox myss.count
GoSub sts
myss.Delete
Exit Sub
sts:
Dim k As Integer
Dim i As Double
Dim j As Double
Dim count As Integer
count = ThisDrawing.SelectionSets.myss.count
ReDim mysss(count - 1) As AcadEntity
For k = 0 To myss.count - 1
Set mysss(k) = ThisDrawing.SelectionSets.myss.Item(k)
StartPoint = myss.Item(k).StartPoint
EndPoint = myss.Item(k).EndPoint
i = 3
j = 0
If StartPoint(i) = StartPoint(j) And StartPoint(i + 1) = StartPoint(j + 1) And StartPoint(i + 2) = StartPoint(j + 2) Then
MsgBox "坐标起点" & EndPoint(j) & "," & EndPoint(j + 1) & "," & EndPoint(j + 2) & "终点" & StartPoint(j) & "," & StartPoint(j + 1) & "," & StartPoint(j + 2) & " name " & myss.Item(k).ObjectName & " ID " & myss.Item(k).ObjectID
myss.Item(k).Layer = "new"
i = i + 3
j = j + 3
myss.RemoveItems mysss
MsgBox myss.count
ElseIf EndPoint(i) = StartPoint(j) And EndPoint(i + 1) = StartPoint(j + 1) And EndPoint(i + 2) = StartPoint(j + 2) Then
MsgBox "坐标起点" & EndPoint(j) & "," & EndPoint(j + 1) & "," & EndPoint(j + 2) & "终点" & StartPoint(j) & "," & StartPoint(j + 1) & "," & StartPoint(j + 2) & " name " & myss.Item(k).ObjectName & " ID " & myss.Item(k).ObjectID
i = i + 3
j = j + 3
myss.Item(k).Layer = "new"
myss.RemoveItems mysss
MsgBox myss.count
Else: MsgBox "no object"
End If
Next
Return
End Sub
要求：在一个封闭的图形中选择一个object，得出端点坐标，然后根据一端端点坐标得出相连object的两个端点坐标，直到得到封闭图像的所有object的端点坐标。（其实就是安一定方向得到端点坐标）
不知道为什么运行的不是按顺序得出端点坐标，请帮忙改一改。或者希望能够提出一个更好的按顺序得出端点坐标的方法。
页:
[1]