Програмиране в ACAD / Компютри и Интернет / CAD/CAM

StSt, благодаря ти за отговора. Скриптът работи чудесно, но аз никак не го разбирам този синтаксис на Lisp :( и реших да го направя на VBA. Ето го и резултатът:

Sub Example_Coordinates()

Dim Selection As AcadSelectionSet
Dim Poly As AcadLWPolyline
Dim Obj As AcadEntity
Dim dblBound As Double
Dim PointMy As AcadPoint
Dim MTextObj As AcadMText
Dim adblCorner(0 To 2) As Double
Dim dblWidth As Double
Dim heightMy
Dim intNumDgtAftDcml As Integer
Dim strText As String
Dim newLayer As AcadLayer
'end----Dobaveno ot men

Set newLayer = ThisDrawing.Layers.Add("Koordinati")
ThisDrawing.ActiveLayer = newLayer
'Makes a selectionset.
On Error Resume Next
Set Selection = ThisDrawing.SelectionSets.Item("Select object.")
If Err Then
Set Selection = ThisDrawing.SelectionSets.Add("Select object.")
Err.Clear
Else
Selection.Clear
End If

ThisDrawing.Utility.Prompt vbCrLf & "Координатор !!!" & _
vbCrLf & "--------------------------------" & vbCrLf
heightMy = ThisDrawing.Utility.GetInteger("? Въведете височина на текста: ")
intNumDgtAftDcml = ThisDrawing.Utility.GetInteger("? Въведете брой символи след десетичната запетая: ")
dblWidth = 0
ThisDrawing.Utility.Prompt vbCrLf & "Изберете обекти:"

Selection.SelectOnScreen

For Each Obj In Selection

If Obj.ObjectName = "AcDbPolyline" Then

Set Poly = Obj
On Error Resume Next

dblBound = UBound(Poly.Coordinates)

x = 0
y = 1

For i = 0 To dblBound / 2

'MsgBox "X= " & Poly.Coordinates(x) & vbCrLf & "Y= " & Poly.Coordinates(y)
adblCorner(0) = Poly.Coordinates(x)
adblCorner(1) = Poly.Coordinates(y)
adblCorner(2) = 0#

strText = "X= " & FormatNumber(Poly.Coordinates(x), intNumDgtAftDcml) & vbCrLf & _
"Y= " & FormatNumber(Poly.Coordinates(y), intNumDgtAftDcml)

' Creates the mtext Object
Set MTextObj = ThisDrawing.ModelSpace.AddMText(adblCorner, dblWidth, strText)
MTextObj.Height = heightMy
MTextObj.Update
ZoomAll

If Err Then
Err.Clear
End If

x = x + 2
y = y + 2

Next

End If
If Obj.ObjectName = "AcDbPoint" Then
Set PointMy = Obj
On Error Resume Next
x = 0
y = 1
'MsgBox "X= " & PointMy.Coordinates(x) & " Y= " & PointMy.Coordinates(y)

adblCorner(0) = PointMy.Coordinates(x)
adblCorner(1) = PointMy.Coordinates(y)
adblCorner(2) = 0#
strText = "X= " & FormatNumber(PointMy.Coordinates(x), intNumDgtAftDcml) & vbCrLf & _
"Y= " & FormatNumber(PointMy.Coordinates(y), intNumDgtAftDcml)

' Creates the mtext Object
Set MTextObj = ThisDrawing.ModelSpace.AddMText(adblCorner, dblWidth, strText)
MTextObj.Height = heightMy
MTextObj.Update
ZoomAll

If Err Then
Err.Clear
End If
End If
Next Obj

End Sub