ADN Club > VBA

Определение габаритов группы выбранных объектов

(1/2) > >>

antonovamarmihalovna:
Добрый день,
макросами в автокаде начала заниматься  с весны 2021, встала, так сказать, острейшая необходимость обработки туевой хучи давальческих разносортных чертежей.
на просторах интернета нашла такой код

Определение габаритов группы выбранных объектов
После запуска процедуры выберите несколько объектов и изображение будет масштабировано по их габаритам.

--- Код - Visual Basic [Выбрать] ---'@~~~~ Get the bounding box of a selection set ~~~~@Public Function GetSSBoundingBox(Min As Variant, _Max As Variant, objSet As AcadSelectionSet) As Boolean  Dim dblMaxX As Double  Dim dblMaxY As Double  Dim dblMinX As Double  Dim dblMinY As Double  Dim varMin As Variant  Dim varMax As Variant  Dim objEnt As AcadEntity  Dim objUtil As Object  On Error GoTo Err_Control  Set objUtil = ThisDrawing.Utility  objSet.Item(0).GetBoundingBox varMin, varMax  dblMinX = varMin(0)  dblMinY = varMin(1)  dblMaxX = varMax(0)  dblMaxY = varMax(1)  'Get the highs and lows  For Each objEnt In objSet    objEnt.GetBoundingBox varMin, varMax    If varMin(0) < dblMinX Then      dblMinX = varMin(0)    End If    If varMin(1) < dblMinY Then      dblMinY = varMin(1)    End If    If varMax(0) > dblMaxX Then      dblMaxX = varMax(0)    End If    If varMax(1) > dblMaxY Then      dblMaxY = varMax(1)    End If  Next objEnt  'Fill the arrays  objUtil.CreateTypedArray Min, vbDouble, dblMinX, dblMinY, 0  objUtil.CreateTypedArray Max, vbDouble, dblMaxX, dblMaxY, 0  GetSSBoundingBox = TrueExit_Here:  Exit FunctionErr_Control:  MsgBox Err.Description  Resume Exit_HereEnd Function  Public Sub Test_GetSSBoundingBox()  Dim acSelSet As AcadSelectionSet  Dim varMin As Variant  Dim varMax As Variant  Dim dblPnts(0 To 5) As Double   Set acSelSet = ThisDrawing.SelectionSets.Add("TestGetSSBB")  acSelSet.SelectOnScreen  GetSSBoundingBox varMin, varMax, acSelSet  ZoomWindow varMin, varMaxEnd Sub
но загвоздка в том, что объекты у меня уже выбранны и выбирать мне их acSelSet.SelectOnScreen не надо, НО если я их не выберу, то у меня не идёт стока Set objUtil = ThisDrawing.Utility и макрос тютюк,
пыталась разобраться и читать справки, но видимо не догоняю, поэтому обращаюсь к вам, знатоки, может вы мне втолкуете или дадите совет, как осуществить это

antonovamarmihalovna:
разобралась
заместо acSelSet.SelectOnScreen надо acSelSet.Select acSelectionSetAll

Александр Ривилис:
antonovamarmihalovna,
Напоминаю про правило форматирования кода на нашем форуме (у меня в подписи)!

Александр Ривилис:

--- Цитата: antonovamarmihalovna от 10-12-2021, 14:29:54 ---разобралась
заместо acSelSet.SelectOnScreen надо acSelSet.Select acSelectionSetAll
--- Конец цитаты ---
Это выбор всего, а не того, что было предварительно выбрано.

antonovamarmihalovna:
ой так приятно от вас получить ответ

это acSelSet.Select acSelectionSetAll мне подходит но

а как тогда чтобы то что было предварительно выбрано.

огромненькое вам спасибо, видео посмотрела, буду делать так, но надеюсь что  буду находить решение вопросов на форуме, я только начинающий в этом, а тут уже тааакие знатоки

Навигация

[0] Главная страница сообщений

[#] Следующая страница

Перейти к полной версии