[Sevas1]

Здравствуйте, я только начинаю разбираться в VBA, касающегося Autocad.

Возникла такая необходимость, чтобы пользователь мог выбрать ряд точек последователь . Без известного изначально количества .
Что типа такого . Только как сделать так чтобы пользователю не приходилось каждый раз нажимать Enter. А просто вібирать точьку а по завершению набрать конец.

Код:

[Выделить все]

Sub a()
Dim p1 As Variant, p2 As Variant
Dim st As String
  p1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "1-ая точка: ")
  ThisDrawing.Utility.InitializeUserInput 0, "конец точка"
Do
p2 = ThisDrawing.Utility.GetPoint(, vbCrLf & "следующая: ")
 st = ThisDrawing.Utility.GetKeyword(vbCrLf & "Введите (конец/[точка]): ")
Loop While sl <> "конец"
end sub

[swell{d}]

Вроде оно: http://forum.nanocad.ru/index.php?showtopic=5273

[Sevas1]

помоему не то

[Александр Ривилис]

Код:

[Выделить все]

Sub a()
    Dim p As Variant
    Dim pts As New Collection
    Dim i As Integer
    i = 1
    Do
      On Error GoTo Endget
      If i = 1 Then
        p = ThisDrawing.Utility.GetPoint(, vbCrLf & CStr(i) & "-ая точка (ENTER - завершение): ")
      Else
        p = ThisDrawing.Utility.GetPoint(p, vbCrLf & CStr(i) & "-ая точка (ENTER - завершение): ")
      End If
      i = i + 1
      pts.Add (p)
    Loop While True
Endget:
    If Err.Number = -2145320928 Then ' Нажато ENTER
     MsgBox "Введено " & CStr(i) & " точек"
    Else ' Нажато ESC
     MsgBox "Ввод точек прерван"
    End If
End Sub

P.S.: На VB/VBA/VB.NET не пишу.

[Sevas1]

Огромное спасибо !!!

[Олег (jr.)]

Я использую похожий метода для отрисовки поолилиний, попробуй

Код:

[Выделить все]

Option Explicit
' Notes:
' 1. requires settings: Tools -> Options -> General tab -> Error trapping field -> check "Break on Unhandled errors"

Public Sub DynPolyline()
' draw lwpolyline interactively
Dim pickPt As Variant
Dim dblCoors() As Double
Dim i As Long
Dim oPoly As AcadLWPolyline

i = 0
On Error Resume Next
pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "First point: ")
If Err = 0 Then
    ReDim dblCoors(1)
    dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
    Do Until Err.Number <> 0
        i = i + 2
        pickPt = ThisDrawing.Utility.GetPoint(pickPt, vbCr & "Pick next point or press Enter to stop: ")
        ReDim Preserve dblCoors(UBound(dblCoors) + 2)
        dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
        If oPoly Is Nothing Then
            Set oPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblCoors)
        Else
            oPoly.Coordinates = dblCoors
        End If
    Loop
    Dim lngResp As Long
    lngResp = MsgBox("Do you want to close polyline?", vbYesNo, "Close Mode")
    If lngResp = 6 Then
    oPoly.Closed = True
    End If
End If
End Sub

[Дмитрий Асташев]

Маленькое, но важное дополнение к коду А. Ривилиса. Перед вызовом Utility.GetPoint, в самом начале функции нужно, скажем так, "деинициализировать" ключевые слова следующим вызовом:

Код:

[Выделить все]

 Dim kwordList As String = ""
doc.Utility.InitializeUserInput(128, kwordList)

Без такой деинициализации возможен случай, когда Utility.GetPoint не позволяет выйти из цикла Do...Loop по нажатию Enter в следствии того, что ключевые слова были инициализированы в какой-либо другой функции. При этом Utility.GetPoint выдает сообщение о неверном ключевом слове и снова запрашивает точку.