先选择点对象,结果输出到dat文件。
vba程序如下:
Option Explicit
Sub 批量求点距()
Dim YSet As AcadSelectionSet
Set YSet = ThisDrawing.PickfirstSelectionSet
If YSet.count = 0 Then
MsgBox "选择点对象": Exit Sub
Else
If MsgBox("如果选择好了点对象,请继续", vbOKCancel, "是否继续?") = vbCancel Then Exit Sub
End If
' MsgBox YSet.count
Dim I As Long
Dim J As Long
Dim PointI As Variant
Dim PointJ As Variant
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim SaveFile As String
SaveFile = Left(ThisDrawing.Path & "\" & ThisDrawing.Name, Len(ThisDrawing.Path & "\" & ThisDrawing.Name) - 3) & "dat"
Open SaveFile For Output As #1
For I = 0 To YSet.count - 2
PointI = YSet(I).Coordinates
X1 = PointI(0)
Y1 = PointI(1)
For J = I + 1 To YSet.count - 1
PointJ = YSet(J).Coordinates
X2 = PointJ(0)
Y2 = PointJ(1)
Debug.Print Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
Print #1, Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
Next
Next
Close #1
End Sub
全部回答(3 )
vba程序如下:
Option Explicit
Sub 批量求点距()
Dim YSet As AcadSelectionSet
Set YSet = ThisDrawing.PickfirstSelectionSet
If YSet.count = 0 Then
MsgBox "选择点对象": Exit Sub
Else
If MsgBox("如果选择好了点对象,请继续", vbOKCancel, "是否继续?") = vbCancel Then Exit Sub
End If
' MsgBox YSet.count
Dim I As Long
Dim J As Long
Dim PointI As Variant
Dim PointJ As Variant
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim SaveFile As String
SaveFile = Left(ThisDrawing.Path & "\" & ThisDrawing.Name, Len(ThisDrawing.Path & "\" & ThisDrawing.Name) - 3) & "dat"
Open SaveFile For Output As #1
For I = 0 To YSet.count - 2
PointI = YSet(I).Coordinates
X1 = PointI(0)
Y1 = PointI(1)
For J = I + 1 To YSet.count - 1
PointJ = YSet(J).Coordinates
X2 = PointJ(0)
Y2 = PointJ(1)
Debug.Print Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
Print #1, Sqr((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2)
Next
Next
Close #1
End Sub