[den_vrn]

VBA, Autocad. Задание звучит так: Разработка функции (VBA), выполняющей размещение произвольного текста по дуге окружности. Т.е. создание штампа или печати.

[Boxa]

И в чем проблема? Разбей строку посимвольно и размещай по траектории с требуемым углом поворота.

[den_vrn]

Без примера никак... Мне бы на код одним глазком поглядеть

[Boxa]

В справке очень хорошо описано, как добавлять текст в чертеж.
В справке VBA Вам помогут функции цикла, Len(), Mid()
Ваша задача действительно не сложная, Вы хотя бы начните, Вам помогут.
Если же ничего не хотите писать, то Вам в другой раздел.

[Сергей812]

как вы делали бы вручную - нарисовали бы окружность и на ней бы размещали буквы.. угол поворота буквы равен углу луча из центра окружности со сдвигом - так как на 12 часов угол поворота должен быть текста должен быть равен 0. Осталось взять примеры из хэлпа, как писал Boxa выше, и заключить их в цикл. Там и код посмотрите)

[den_vrn]

А как определить точку где вставлять буквы?

Код:

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

Sub CreateText()
  
  Dim textString As String
  Dim i As Integer

  Dim height As Double
  X = 0
  Y = 0
  textString = "Hello, World."
  insertionPoint = cpoint  'centr okrujnosti
  insertionPoint(1) = insertionPoint(1) + Radius + 50  '1 tochka na 12 chasov

  height = 100
  i = Len(textString) ' dlina
  For i = 1 To i
  ch = Mid(textString, i, 1) 'bukva
  insertionPoint(0) = insertionPoint(0) + X ' hag po X
  insertionPoint(1) = insertionPoint(1) - Y ' hag po Y
  Set textObj = ThisDrawing.ModelSpace.AddText(ch, insertionPoint, height)
  
  'textObj.Rotation = -0.707
  'textObj.Update

  X = 100
  Y = 50
    
  Next i
  
End Sub

[Сергей812]

Сообщение от den_vrn А как определить точку где вставлять буквы?

например, с помощью параметрического уравнения окружности

[gomer]

Вам не надоело велосипеды изобретать??? Уже вроде не сессия

[den_vrn]

Сообщение от gomer Вам не надоело велосипеды изобретать??? Уже вроде не сессия

У заочников сессия только началась

Сообщение от Сергей812 например, с помощью параметрического уравнения окружности

Помогло !!!


ВСЕМ СПАСИБО ВСЕ ПОЛУЧИЛОСЬ !!!

[gomer]

Сообщение от Сергей812 например, с помощью параметрического уравнения окружности

Для тех, кому лень учить матчасть

Сообщение от den_vrn ВСЕМ СПАСИБО ВСЕ ПОЛУЧИЛОСЬ !!!

как сдашь, не забудь выложить окончательный вариант... возможно кому-то пригодится...

[Сергей812]

Сообщение от gomer Для тех, кому лень учить матчасть

неизвестно, что быстрее, кстати - считать геометрию или использовать вычислительные способности движка автокада через vba)

[den_vrn]

Сто пудово здам, так что сразу выкладываю, только вот что-то с комментариями беда.

Код:

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

Sub CreateText()
  Dim MyAngle
  Dim i As Integer
  MyAngle = 1.57 ' начальный угол 90 для букв
  Naklon = 0     ' начальный угол для наклона
  Radius = Radius + Visota ' Радиус для букв
  insertionPoint = cpoint  'Центр
  i = Len(Stroka) ' длина текста
  ugol = 6.28 / i ' угол для равномерного расположения букв
  
  For i = 1 To i
  ch = Mid(Stroka, i, 1) ' Разбитие строки на буквы
  
  'Параметрическое уровнение для поиска точки каждой буквы
  insertionPoint(0) = cpoint(0) + Radius * Cos(MyAngle)
  insertionPoint(1) = cpoint(1) + Radius * Sin(MyAngle)
    
  Set textObj = ThisDrawing.ModelSpace.AddText(ch, insertionPoint, Visota) 'установка буквы
  
  textObj.Rotation = Naklon ' наклон буквы относительно окружности
  textObj.Update
  
  MyAngle = MyAngle - ugol ' шаг буквы
  Naklon = Naklon - ugol   ' шаг наклона
     
  Next i
  
End Sub

[Сергей812]

Эта проблема с кодировкой для VBA как в офисе, так и в автокаде. Попробуйте так: откройте блокнот и там сделайте русскую раскладку для ввода. Затем в VBA в автокаде тоже переключитесь на русский. И только после этого выделяйте текст и копируйте в блокнот. Обратно тоже работает)