• Builder
  • Восстановленный участник
  • На форуме с 13 марта 2007г.
  • Сообщений: 11
  • Спасибо: 0

Тема: Создание стиля текста?Удаление слоя?

Подскажите как создать новый стиль текста("style1"например)? И как удалить слой? delete не работает(

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: Создание стиля текста?Удаление слоя?

ThisDrawing.Layers.Add ("LayerName")
ThisDrawing.Layers("LayerName").Delete
'Слой не должен быть активным
'Cлой не должен содержать объектов

  • SmeL
  • SmeL
  • Активный участник
  • Откуда: Молдова
  • На форуме с 29 сентября 2005г.
  • Сообщений: 464
  • Спасибо: 1

Re: Создание стиля текста?Удаление слоя?

создать новый стиль текста

Ищем по ключу TextStyle property в справке ACAD

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 2

Re: Создание стиля текста?Удаление слоя?

> Builder
Создать стиль (сделал на на скорую руку)
так что проверяй сам
~'J'~

Option Explicit
Public Sub CreateTextStyle(ByVal styleName As String, _
ByVal fontFil As String, _
ByVal txtHeight As Double, _
ByVal txtWidth As Double, _
ByVal txtAngle As Double)
Dim txtStyleObj As AcadTextStyle
On Error GoTo Err_Control
If TextStyleExists(styleName) = False Then
Set txtStyleObj = ThisDrawing.TextStyles.Add(styleName)
With txtStyleObj
.fontFile = fontFil
.Height = txtHeight
.Width = txtWidth
.ObliqueAngle = txtAngle
End With
ThisDrawing.ActiveTextStyle = txtStyleObj
Else
MsgBox "Textstyle " & "" & styleName & "" & " does already exist"
Exit Sub
End If
Err_Control:
If Err.Number <> 0 Then MsgBox Err.Description
End Sub
Public Function TextStyleExists(styleName As String) As Boolean
'// Frank Oquendo's method
Dim obj As AcadTextStyle
On Error Resume Next
Set obj = ThisDrawing.TextStyles.Item(styleName)
TextStyleExists = (Err.Number = 0)
End Function
Sub test()
Dim styleName As String
Dim fontFil As String
Dim txtHeight As Double
Dim txtWidth As Double
Dim txtAngle As Double
styleName = "NewTextStyle"
fontFil = "simplex.shx"
txtHeight = 0#
txtWidth = 0.8
txtAngle = 0#
Call CreateTextStyle(styleName, fontFil, txtHeight, txtWidth, txtAngle)
End Sub