• aleksey_dav
  • Восстановленный участник
  • На форуме с 6 марта 2008г.
  • Сообщений: 8
  • Спасибо: 0

Тема: Как добавить штриховку на VBA в AutoCad

Как создать окружность, а затем добавить штриховку на VBA в AutoCad? И если есть у кого справочник по VBA для AutoCad, то скиньте пожалуйста.

  • AlexV
  • Активный участник
  • Откуда: С-Пб
  • На форуме с 19 июня 2003г.
  • Сообщений: 330
  • Спасибо: 4

Re: Как добавить штриховку на VBA в AutoCad

Добавление штриховки в блок
Создайте в чертеже блок, в котором была бы хоть одна окружность, задайте ему имя test, и поместите в стандартный модуль следующую ниже процедуру. Если запустить ее, то все окружности в блоке будут заштрихованы штриховкой типа ANSI31

Public Sub ReDefineWithHatch()
  Dim objhatch As AcadHatch
  Dim objBlk As AcadBlock
  Dim objLoop(0) As AcadEntity
  Dim objent As AcadEntity
  Set objBlk = ThisDrawing.Blocks("test")
  For Each objent In objBlk
    If TypeOf objent Is AcadCircle Then
      Set objLoop(0) = objent
      Set objhatch = objBlk.AddHatch(1, "ANSI31", True)
      objhatch.AppendOuterLoop objLoop
      objhatch.Evaluate
      'Exit For
    End If
  Next
  ThisDrawing.Regen acAllViewports
End Sub

http://www.cad.dp.ua/stats/a_vba/acenti … eWithHatch

  • aleksey_dav
  • Восстановленный участник
  • На форуме с 6 марта 2008г.
  • Сообщений: 8
  • Спасибо: 0

Re: Как добавить штриховку на VBA в AutoCad

Это не совсем то, что было нужно. Мне хотелось бы реализовать это автоматически т.е. с помощью макроса создается окружность, а затем также с помощь макроса добавляется в неё сплошная штриховка черного цвета.

  • ssn
  • Активный участник
  • На форуме с 7 декабря 2003г.
  • Сообщений: 225
  • Спасибо: 1

Re: Как добавить штриховку на VBA в AutoCad

надо открыть встроенный хелп, там есть примеры.. все подробно

  • ssn
  • Активный участник
  • На форуме с 7 декабря 2003г.
  • Сообщений: 225
  • Спасибо: 1

Re: Как добавить штриховку на VBA в AutoCad

хотя наверно так говорить и не хорошо....
а чем этот пример не подходит?
выбираем объект через селект, потом пихаем его в Set objLoop(0) = objent и все как выше описано...