[VVS]

Уважаемые,
хочется иметь такую штуку, чтобы запрашивался начальный номер листа, далее по щелчку на номере листа присваивался номер в формате (начальный номер.1), далее по щелчку на следующем тексте он менялся на (начальный номер.2) и т.д.
Как это сделать?

[Коробейников Алексей]

На VBA:

Код:

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

Public Sub Нумерация()
Dim SelectObg As Object
Dim Выбор As AcadEntity
Dim Коментарий As String
Dim varPnt As Variant
Dim Счетчик As Double
Dim ТипФильтра(0 To 3) As Integer
Dim ДанныеФильтра(0 To 3) As Variant

ТипФильтра(0) = -4
ТипФильтра(1) = 0
ТипФильтра(2) = 0
ТипФильтра(3) = -4

ДанныеФильтра(0) = "<OR"
ДанныеФильтра(1) = "TEXT"
ДанныеФильтра(2) = "MTEXT"
ДанныеФильтра(3) = "OR>"
On Error GoTo Конец:
Счетчик = InputBox("Начальный номер", , 1)
Следующий:
    Коментарий = "Выберите текст: "
    ThisDrawing.Utility.GetEntity Выбор, varPnt, Коментарий ' выбираем объект на экране
    Set SelectObg = Выбор 'присваиваем выбранное объекту
    SelectObg.textString = Счетчик
    Счетчик = Счетчик + 1
    GoTo Следующий
Exit Sub
Конец:
End Sub

Удачи

[VVS]

Спасибо, почти то что надо.
Немного поправил и получил то что хотел.
Вопрос про VBA
Для чего это?

ТипФильтра(0) = -4
ТипФильтра(1) = 0
ТипФильтра(2) = 0
ТипФильтра(3) = -4

ДанныеФильтра(0) = "<OR"
ДанныеФильтра(1) = "TEXT"
ДанныеФильтра(2) = "MTEXT"
ДанныеФильтра(3) = "OR>"

И где можно поподробнее узнать про VBA для Autocad?

[Коробейников Алексей]

Н..да это лишняя деталь!?

Это фильтры для выбора объектов на экране (выбираются только текст или Мтекс). В данном случае они не нужны у GetEntity нет фильтра.

Могу для кучи предложить еще Код:
(копирует содержимое текста или атрибута блока другому тексту или атрибуту)

Код:

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

Public Sub КопированиеТекста()
Dim i As Double
Dim SelectObg As Object
Dim Атрибут As Variant
Dim Строка As String
Dim Выбор As AcadEntity
Dim ТипФильтра(0 To 4) As Integer
Dim ДанныеФильтра(0 To 4) As Variant
Dim Коментарий As String
Dim varPnt As Variant

ТипФильтра(0) = -4
ТипФильтра(1) = 0
ТипФильтра(2) = 0
ТипФильтра(3) = 0
ТипФильтра(4) = -4

ДанныеФильтра(0) = "<OR"
ДанныеФильтра(1) = "TEXT"
ДанныеФильтра(2) = "MTEXT"
ДанныеФильтра(3) = "INSERT"
ДанныеФильтра(4) = "OR>"
On Error GoTo идти
    Строка = ""
    Коментарий = "Выберите исходный текст или блок с атрибутом: " '& vbCrLf
    For Each SelectObg In ВыборНаЭкране(ТипФильтра, ДанныеФильтра)
        If (SelectObg.ObjectName = "AcDbMText") Or (SelectObg.ObjectName = "AcDbText") Then
             Строка = Строка + SelectObg.textString + ""
        End If
        If SelectObg.ObjectName = "AcDbBlockReference" Then
            Атрибут = SelectObg.GetAttributes
            Строка = Строка + Атрибут(0).textString + ""
        End If
    Next SelectObg
    ThisDrawing.Utility.Prompt ("Присвоить тексту или блоку с атрибутом: ")
    For Each SelectObg In ВыборНаЭкране(ТипФильтра, ДанныеФильтра)
        If (SelectObg.ObjectName = "AcDbMText") Or (SelectObg.ObjectName = "AcDbText") Then
            SelectObg.textString = Строка
        End If
        If SelectObg.ObjectName = "AcDbBlockReference" Then
            If SelectObg.HasAttributes Then
                 Атрибут = SelectObg.GetAttributes
                 Атрибут(0).textString = Строка
            End If
        End If
    Next SelectObg
Exit Sub
идти:
End Sub

Public Function ВыборНаЭкране(Optional ТипФильтра As Variant, Optional ДанныеФильтра As Variant) As AcadSelectionSet
Dim НаборОбъектов As AcadSelectionSet
Dim КолкцияНаборовОбъектов As AcadSelectionSets

Set КолкцияНаборовОбъектов = ThisDrawing.SelectionSets
For Each НаборОбъектов In КолкцияНаборовОбъектов
  If НаборОбъектов.Name = "НАБОР" Then
    НаборОбъектов.Delete
    Exit For
  End If
Next НаборОбъектов
Set НаборОбъектов = ThisDrawing.SelectionSets.Add("НАБОР")
НаборОбъектов.SelectOnScreen ТипФильтра, ДанныеФильтра
Set ВыборНаЭкране = НаборОбъектов
End Function

Есть форум VBA под Автокад http://www.autocad.ru/cgi-bin/f1/board.cgi?p=025