|
Тема |
Re: Програмиране в ACAD [re: StSt] |
|
Автор | Dim (Нерегистриран) | |
Публикувано | 25.10.06 14:52 |
|
|
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
|
| |
|
|
|