Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → VBA → КОПИРОВАТЬ СОВМЕСТИМЫЕ СВОЙСВА
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте знатоки.
мне нужно большое количество дуг прератить в круги
и при этом все совместимые свойство должны быть скопированы как будто исползована команда matchrpoperties.
я смогу удалить дугу и вставить круг на его центр.
в остальном прошу Вас помочь.
заранее благодарен
А так подойдет?
Dim returnObj As AcadArc
Dim basePnt As Variant
On Error Resume Next
' The following example waits for a selection from the user
RETRY:
ThisDrawing.Utility.GetEntity returnObj, basePnt, "Select an arc"
returnObj.EndAngle = 360 * (3.14 / 180) + returnObj.StartAngle
Жалко, что не лисп :( На лиспе это делается проще...
> Кулик Алексей aka kpblc
Еще проще???
Ага. Ты фактически надеешься на срабатывание бага точности округления углов. А не создаешь новый объект. ИМХО надо именно создавать новые объекты и с ними ковыряться. В лиспе:
(defun c:conv-arc-to-circle (/ *error* adoc selset obj)
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(if (setq selset (ssget "_:L" '((0 . "ARC"))))
(foreach item (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
) ;_ end of mapcar
(setq obj (vla-addcircle
(vla-objectidtoobject adoc (vla-get-ownerid item))
(vla-get-center item)
(vla-get-radius item)
) ;_ end of vla-addcircle
) ;_ end of setq
[b](foreach prop '("normal" "center" "layer"
"lineweight" "linetype" "color"
"truecolor" "plotstylename" "thickness"
"linetypescale"
)
(vl-catch-all-apply
'(lambda ()
(vlax-put-property obj prop (vlax-get-property item prop))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of foreach[/b]
(vla-erase item)
) ;_ end of foreach
) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defunПолужирным выделен как раз тот кусок, который на VBA длиннее получится на порядок, а то и больше
P.S. Естественно, при условии создания нового примитива :)
И вот еще. К моем коде не отслеживается состояние слоев. Также не могу гарантировать, как будет работать внутри внешних ссылок и блоков (особенно динамических).
Наконец, последнее, и я отстану. Сейчас список свойств передается фиксированным, но его можно сформировать и динамически (типа вычислить) - тогда вообще будет передаваться все что только возможно.
Больщая благодарность всем, особенно Кулик Алексей aka kpblc.
> Кулик Алексей aka kpblc
Ага. Ты фактически надеешься...
Да нет, не надеюсь. Просто меня подводит (или выручает) инженерное мышление: выполнить конкретное задание с минимальными трудозатратами, вот и предложил вариант. Но, конечно понимал - только свяжись с тобой, тут же получишь код в ответ. Поэтому солидарен с автором темы:
Больщая благодарность .... особенно Кулик Алексей aka kpblc.
От себя добавлю, не очень понял насчет динамического списка свойств, ведь пересечение двух множеств - свойства арки и свойства дуги дает вполне фиксированный результат. Я постарался его проиллюстрировать ниже.
Sub ArcToCircle()
Dim vArc As AcadArc
Dim basePnt As Variant
On Error Resume Next
ThisDrawing.Utility.GetEntity vArc, basePnt, "Select an arc"
Dim vCircle As AcadCircle
Dim vCenter As Variant
Dim vRadius As Double
vCenter = vArc.Center
vRadius = vArc.Radius
Set vCircle = ThisDrawing.ModelSpace.AddCircle(vCenter, vRadius)
[b] vCircle.Color = vArc.Color
vCircle.Layer = vArc.Layer
vCircle.Linetype = vArc.Linetype
vCircle.LinetypeScale = vArc.LinetypeScale
vCircle.Lineweight = vArc.Lineweight
vCircle.Normal = vArc.Normal
vCircle.PlotStyleName = vArc.PlotStyleName
vCircle.Thickness = vArc.Thickness
vCircle.Visible = vArc.Visible[/b]
vArc.Delete
End SubP.S. В дискуссии типа "Какой язык программирования лучшее" не дам себя втянуть.
Потому что это давно известно.
> LeonidSN
Дело в том, что (я уже подробностей не помню, мне хватило результата) при некоторых условиях поведение с точки зрения пользователя окружности и дуги различается. И то, что в дуге показывается угол 360, не означает, что он таковым и является: он близок к 360, но не равен ему. Короче, чтоб не растекаться мыслию по древу: дуга должна оставаться дугой, окружность - окружностью.
Насчет динамического получения свойств:
В VLIDE можно выполнить такой кодик:
_$ (setq mask "vla-get-" lst (mapcar '(lambda(a) (substr a (1+ (strlen mask)))) (vl-remove-if-not '(lambda(x) (wcmatch(strcase x t) (strcat mask "*"))) (atoms-family 1)))) _$ (length lst) 596
Самое интересное - это lst. В нем хранятся все свойства, которые могут быть установлены для объектов в activex-варианте лиспа. Содержимое lst не показываю - там 596 (!) возможных свойств. Упаришься все вспоминать. Вариант для всех возможных свойств:
(defun c:conv-arc-to-circle (/ *error* adoc selset obj)
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-startundomark
(if (setq selset (ssget "_:L" '((0 . "ARC"))))
(foreach item (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
) ;_ end of mapcar
(setq obj (vla-addcircle
(vla-objectidtoobject adoc (vla-get-ownerid item))
(vla-get-center item)
(vla-get-radius item)
) ;_ end of vla-addcircle
) ;_ end of setq
(foreach prop (mapcar '(lambda (a) (substr a (1+ (strlen "vla-get-"))))
(vl-remove-if-not
'(lambda (x) (wcmatch (strcase x t) "vla-get-*"))
(atoms-family 1)
) ;_ end of vl-remove-if-not
) ;_ end of mapcar
(vl-catch-all-apply
'(lambda ()
(vlax-put-property obj prop (vlax-get-property item prop))
) ;_ end of lambda
) ;_ end of vl-catch-all-apply
) ;_ end of foreach
(vla-erase item)
) ;_ end of foreach
) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defunНо! Тут есть одно "но". Если OCS для исходной дуги не совпадает с текущей, при таком подходе возможен "глюк" - окружность "улетит" черт-те куда. Можно, конечно, обойти, но уже лениво.
P.S.
В дискуссии типа "Какой язык программирования лучшее" не дам себя втянуть.
Мне это уже неизвестно :) 2,5 языка приходится в голове держать, мозги кипять :D
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → VBA → КОПИРОВАТЬ СОВМЕСТИМЫЕ СВОЙСВА
Форум работает на PunBB, при поддержке Informer Technologies, Inc
