|
|
发表于 2010-6-5 14:43:00
|
显示全部楼层
Sub Test()
Dim Pt As Variant
Dim i As Integer
Dim Objlw1 As AcadLWPolyline
Dim Objlw2 As AcadLWPolyline
ThisDrawing.Utility.GetEntity Objlw1, Pt, "选择多段线"
ThisDrawing.Utility.GetEntity Objlw2, Pt, "选择多段线"
Dim Cor1 As Variant
Dim Cor2 As Variant
Cor1 = Objlw1.Coordinates
Cor2 = Objlw2.Coordinates
If UBound(Cor1) UBound(Cor2) Then
MsgBox "形状不同，顶点数不一致,第一条多线段顶点为" & (UBound(Cor1) + 1) / 2 & "第二条多线段顶点数为：" & (UBound(Cor2) + 1) / 2
Exit Sub
End If
For i = 2 To UBound(Cor1)
If Cor1(i) - Cor1(i - 2) Cor2(i) - Cor2(i - 2) Then
MsgBox "形状不同，不同的顶点为：" & (CInt(i / 2) - 1)
Debug.Print i
Exit Sub
End If
Next
MsgBox "形状相同"
End Sub |
|
置顶卡
