Немного макросов для операций с размерами (от базы; масштаби
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Немного макросов для операций с размерами (от базы; масштаби

Немного макросов для операций с размерами (от базы; масштаби

Ответ
Поиск в этой теме
Непрочитано 06.08.2007, 16:35 #1
Немного макросов для операций с размерами (от базы; масштаби
mmmx
 
Москва
Регистрация: 06.07.2006
Сообщений: 42

Предлагаю макросы, помогающие:

1. в простановке базовых размеров.
Это процедура "базовый". В связи с тем, что она вносит изменения в текущий размерный стиль, приходится подменять команду простановки линейного размера dimlinear (процедура "линейный"), которая изменяет установки на стандартные (но, между прочим, не первоначальные!)

2. в масштабировании изображения размера на чертеже (увеличение/уменьшение размера шрифта, стрелок и т.д.)
Это процедуры "РАЗМЕР_УВЕЛИЧИТЬ", "РАЗМЕР_УМЕНЬШИТЬ".
Соответственно они вызывают (с помощью процедуры "ИЗМЕНИТЬ_ПРОСТАВЛЕННЫЕ_РАЗМЕРЫ") визуальное масштабирование уже проставленных на чертеже ВСЕХ размеров.

Все эти команды я вывел на кнопки.

В общем, это макросы не для спецов, а для, скажем так, оформителей (гост не соблюдается, код особо не блещет красотой и грамотностью...).
Мне эти недостающие функции сильно портили настроение, надеюсь, кому-нибудь они пригодятся как шаблон, все ж не самому набивать . Извиняюсь, если не туда запостил...
Алексею Кулику еще раз большое спасибо, без него бы не справился


Код:
[Выделить все]
Sub базовый()
'************************************************************************
'Этой процедурой я подменяю команду простановки базового размера -
' dimbaseline
'Процедура делает установки для базового размера
'************************************************************************
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMBLK1" & vbCr & "МалТочка" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMSAH" & vbCr & "Вкл" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMTAD" & vbCr & "0" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMJUST" & vbCr & "4" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMDLI" & vbCr & "0" & vbCr

ThisDrawing.SendCommand "_dimbaseline" & vbCr
End Sub
Код:
[Выделить все]
Sub линейный()
'************************************************************************
'Этой процедурой я подменяю команду простановки линейного размера -
' dimlinear.
'Эта процедура требуется для возврата установок с базового на линейный
' после команды "базовый"
'************************************************************************
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMBLK1" & vbCr & "" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMSAH" & vbCr & "Откл" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMTAD" & vbCr & "1" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMJUST" & vbCr & "0" & vbCr
ThisDrawing.SendCommand "_setvar" & vbCr & "DIMDLI" & vbCr & "0" & vbCr

ThisDrawing.SendCommand "_dimlinear" & vbCr

End Sub
Код:
[Выделить все]
Sub РАЗМЕР_УВЕЛИЧИТЬ()
'************************************************************************
'данная процедура увеличивает основные размеры текущего размерного
'стиля, и прописывает измененные значения в соответствующие
'системные переменные
'************************************************************************
Dim DIMEXE As Variant
  DIMEXE = ThisDrawing.GetVariable("DIMEXE")
  
  DIMEXE = DIMEXE + 5 'увеличиваем на 5 единиц
  DIMTXT = DIMEXE * 3
  DIMASZ = DIMEXE * 3
  DIMEXO = 0
  DIMGAP = DIMEXE
  
ThisDrawing.SetVariable "DIMEXE", DIMEXE
ThisDrawing.SetVariable "DIMTXT", DIMTXT
ThisDrawing.SetVariable "DIMASZ", DIMASZ
ThisDrawing.SetVariable "DIMEXO", DIMEXO
ThisDrawing.SetVariable "DIMGAP", DIMGAP

'соответственно произведенным изменениям масштабируем ВСЕ(!!!) проставленные
'на чертеже размеры
ИЗМЕНИТЬ_ПРОСТАВЛЕННЫЕ_РАЗМЕРЫ
End Sub
Код:
[Выделить все]
Sub РАЗМЕР_УМЕНЬШИТЬ()
'************************************************************************
'данная процедура уменьшает основные размеры текущего размерного
'стиля, и прописывает измененные значения в соответствующие
'системные переменные
'************************************************************************
Dim DIMEXE As Variant
  DIMEXE = ThisDrawing.GetVariable("DIMEXE")
  key = 5
  If DIMEXE < 6 Then key = 1 'при приближении к мелкому шрифту уменьшаем шаг
  If DIMEXE < 2 Then Exit Sub
  DIMEXE = DIMEXE - key 'уменьшаем на 5 (или с размера 6 на одну) единиц
  DIMTXT = DIMEXE * 3
  DIMASZ = DIMEXE * 3
  DIMEXO = 0
  DIMGAP = DIMEXE
  
ThisDrawing.SetVariable "DIMEXE", DIMEXE
ThisDrawing.SetVariable "DIMTXT", DIMTXT
ThisDrawing.SetVariable "DIMASZ", DIMASZ
ThisDrawing.SetVariable "DIMEXO", DIMEXO
ThisDrawing.SetVariable "DIMGAP", DIMGAP

'соответственно произведенным изменениям масштабируем ВСЕ(!!!) проставленные
'на чертеже размеры
ИЗМЕНИТЬ_ПРОСТАВЛЕННЫЕ_РАЗМЕРЫ
End Sub
Код:
[Выделить все]
Public Sub ИЗМЕНИТЬ_ПРОСТАВЛЕННЫЕ_РАЗМЕРЫ()
'изменение в уже проставленных на чертеже размерах следующих параметров (размеров):
'размера текста,
'размера стрелок,
'величины хвостиков размерных линий,
'величины отстояния текста от размерной линии
Dim layerObj As AcadLayer
Dim ssetObj As AcadSelectionSet
Dim setCol As AcadSelectionSets
Dim insSet As AcadSelectionSet
Set setCol = ThisDrawing.SelectionSets

Dim DIMEXE  As Variant
DIMEXE = ThisDrawing.GetVariable("DIMEXE")
  DIMTXT = DIMEXE * 3
  DIMASZ = DIMEXE * 3
  DIMEXO = 0
  DIMGAP = DIMEXE


For Each insSet In setCol
    If insSet.Name = "SSETORDER" Then
        insSet.Delete
        Exit For
    End If
Next insSet

Dim FData(0) As Variant
Dim FType(0) As Integer
    FType(0) = 0
    FData(0) = "DIMENSION"
    
Set ssetObj = ThisDrawing.SelectionSets.Add("SSETORDER")
Mode = acSelectionSetAll
ssetObj.Select Mode, , , FType, FData

Dim ssobjs(0) As AcadDimension
For Each ent In ssetObj
Set ssobjs(0) = ent
ssobjs(0).TextHeight = DIMASZ
ssobjs(0).ArrowheadSize = DIMASZ
'ssobjs(0).ExtensionLineOffset=DIMEXO 'EXO
ssobjs(0).ExtensionLineExtend = DIMEXE
ssobjs(0).TextGap = DIMGAP

Next ent

End Sub
Просмотров: 3162
 
Непрочитано 07.08.2007, 09:36
#2
Bull

Конструктор по сути (машиностроитель)
 
Регистрация: 10.10.2005
Набережные Челны (это где КамАЗ)
Сообщений: 11,391


М...дя Зачем Autodesk придумывает стили размеров и панель свойств, если всё можно через макросы делать?
__________________
Век живи, век учись - ...
Bull вне форума  
 
Автор темы   Непрочитано 07.08.2007, 09:55
#3
mmmx


 
Регистрация: 06.07.2006
Москва
Сообщений: 42


Ну проще мне так, проще...
На новом листе все по умолчанию, пока разберешься и выставишь их, время идет...
И вообще - люблю, когда сделано своими руками

А что, это все и вправду можно настроить?
mmmx вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Немного макросов для операций с размерами (от базы; масштаби