[XYZ]

Как быстро рисовать стрелки (односторонняя: отрезок + наконечник стрелы) разной длины и наклона на плоскости в ACAD? Использовать Leader не всегда возможно, т.к. приходится бороться с полочкой, которая не нужна (когда Leader поворачиваешь, образуется полочка, даже если ее раньше удалось истребить).
Опытные, помогите плиз.

[Александр Бауск]

Какая версия Автокада?

[XYZ]

Версии 2005 и 2007

[Александр Бауск]

Вот выдрал подпрограмму из своей надстройки. Вставляет стрелку в виде лидера.

Код:

[Выделить все]

Public Sub InsertArrow1()
On Error Resume Next

Dim KWord As String
Dim KWords As String
Dim Point1, Point2 As Variant
Dim Ldr As AcadLeader
Dim Angle1, ToScale As Double
Dim annotationObject As AcadEntity
Dim Pnts(0 To 5) As Double

'Определяем параметры вставки
'ToScale = Settings.GetScale

'KWords = "C O CR D A"
'ThisDrawing.Utility.InitializeUserInput 2, KWords
'KWord = ThisDrawing.Utility.GetKeyword("Введите тип стрелки [Closed/Open/Dot/CRoss/Anchor] <Open>:")

AGAIN:
'Запрашиваем точку вставки
On Error Resume Next
Err.Clear
Point1 = Nothing
Point1 = ThisDrawing.Utility.GetPoint(Prompt:="Введите точку начала стрелки или <Выход>:")
If Userio.CheckKey(VK_ESCAPE) Then Exit Sub
If IsError(Point1(0)) Then Exit Sub


'Запрашиваем вторую точку вставки
Err.Clear
Point2 = Nothing
Point2 = ThisDrawing.Utility.GetPoint(Point1, "Введите точку конца стрелки или <Выход>:")
If Userio.CheckKey(VK_ESCAPE) Then Exit Sub
If IsError(Point2(0)) Then Exit Sub 'Вывалиться совсем

On Error GoTo 0
'Угол наклона будущей вставки от оси 0x
Angle1 = ThisDrawing.Utility.AngleFromXAxis(Point1, Point2)

Dim Arr(0) As Variant
Set annotationObject = Nothing
Pnts(0) = Point2(0): Pnts(1) = Point2(1): Pnts(2) = Point2(2)
Pnts(3) = Point1(0): Pnts(4) = Point1(1): Pnts(5) = Point1(2)
Set Ldr = ThisDrawing.ModelSpace.AddLeader(Pnts, annotationObject, acLineWithArrow)

'Select Case KWord
'Case "", "O"
'Ldr.ArrowheadBlock = "E2Open"
'Case "C"
'Ldr.ArrowheadBlock = "rtrt"
'Case "CR"
'Ldr.ArrowheadBlock = "E2Cross1"
'Case "D"
'Ldr.ArrowheadBlock = "E2Dot"
'Case "A"
'Ldr.ArrowheadBlock = "E2Anchor1"
'End Select

'Set Arr(0) = Ldr
'Updaters.SetStandardsByScale Arr, ToScale
On Error Resume Next
GoTo AGAIN
End Sub

[Александр Бауск]

Так, ладно.
Могу вот дать инсталлятор, если вы не обломаетесь ставить. На 2005 автокад.

[Александр Бауск]

Установить и в автокаде написать команду ALTOLOAD
После этого можете щелкать по кнопке с зелененькой стрелочкой или команда E2ARR

[Огурец]

Если вручную, то стрелка чертится полилинией с переменной шириной.

[Кулик Алексей aka kpblc]

Или блоком. Или Aligned-размером с подавленными выносными, отключенным 2-м элементом и переопределенным текстом Вариантов масса.

[XYZ]

Александр Бауск, спасибо, но у меня с программированием туго, не осилю.
А вот полилинию применил на практике. Понравилось.

[Кулик Алексей aka kpblc]

Полилиния хороша до первого применения overkill.

[Jerald]

А я на глазок прикидую

[Krieger]

Это чем не нравится?

Код:

[Выделить все]

^C^C_leader;\\;;_n

[Profan]

Сообщение от Кулик Алексей aka kpblc Полилиния хороша до первого применения overkill.

А что с ней сделает overkill?

[Profan]

Вот программа изменения ширины произвольного сегмента полилинии:

Код:

[Выделить все]

 
  ;**************** lw_width.lsp *********************************
  ;  Изменение начальной и конечной ширины
  ;  произвольного сегмента полилинии.
  ;  Автор  Евгений Елпанов.
(defun C:LW_WIDTH(/ ENDWIDTH GR LW PAR STARTWIDTH)
(vl-load-com)
(vla-StartUndoMark(vla-get-activedocument(vlax-get-acad-object)))
(setq lw(entsel "\n Выберите нужный сегмент в полилинии. "))
(if(and lw(=(cdr(assoc 0(entget(car lw)))) "LWPOLYLINE"))
(progn(setq par(vlax-curve-getParamAtPoint(car lw)
(vlax-curve-getClosestPointTo(car lw)(cadr lw)))
 lw(vlax-ename->vla-object(car lw)))
(princ "\n Задайте ширину начала сегмента.\t")
(vla-GetWidth lw(fix par) 'StartWidth 'EndWidth)
(while(and(setq gr(grread 5))(=(car gr) 5))
(vla-SetWidth lw(fix par)
(setq StartWidth(*(distance(cadr gr)
(vlax-curve-getClosestPointTo lw(cadr gr))) 2.))EndWidth))
(if(=(car gr) 2)(vla-SetWidth lw(fix par)
(setq StartWidth(atof(strcat(princ(vl-list->string(cdr gr)))
(getstring)))) EndWidth))
(princ "\n Задайте ширину конца сегмента.\t")
(while(and(setq gr(grread 5))(=(car gr) 5))
(vla-SetWidth lw(fix par) StartWidth(*(distance(cadr gr)
(vlax-curve-getClosestPointTo lw(cadr gr))) 2.)))
(if(=(car gr) 2)(vla-SetWidth lw(fix par) StartWidth
(atof(strcat(princ(vl-list->string(cdr gr)))(getstring))))))
(princ "\n Ничего не выбрано или объект не полилиния.\t"))
(vla-EndUndoMark(vla-get-activedocument(vlax-get-acad-object)))
(princ)
)

Почему-то VVA не захотел включить ее в свой пакет программ для работы с полилинией.

[Александр Бауск]

Ну так возьмите инсталятор. Там экзешник с пакетом, который я у себя в конторе использую, сырой, правда, все руки не дойдут до ума довести. Программировать не надо. Заодно сможете им масштаб отображения контролировать.

[Hans667]

Сообщение от Александр Бауск Так, ладно. Могу вот дать инсталлятор, если вы не обломаетесь ставить. На 2005 автокад.

а на последущие версии ничего похожего нет?

[Александр Бауск]

>а на последущие версии ничего похожего нет?

Не-а. С нового года буду серьезно заниматься.
Хочу забабахать туда менеджер слоев, всякую хрень для CAD-менеджерства типа пользовательских конвертеров и шаблонов слоев и свойств, упрощенную быструю выборку типа "1) выделить рамкой все, 2) выбросить из выделения все размеры, 3) а теперь оставим только вертикальные линии", средства для централизованной настройки и так далее.

[Yura]

У меня все проще: просто блок вставляю с соответствующим масштабом...

[misht]

а в Download-ах выкладывали неплохую динамическую стрелку, я ей пользуюсь, если быстро нада...

[XYZ]

Yura, в ACAD-2007 ни чего не вижу. Стрелка- невидимка.

[Yura]

XYZ,
Цитата:
- Суслика видишь?
- Нет..
- А он есть...
- Понятно..
(с)ДМБ
Просто попробуй вставить, как блок... А версия Автокада вообще не имеет значения, т.к. создан этот "шедевр" где-то в 2000-м, а в силу лени, пользуемся им до сих пор...

Кстати, на скрине скачанное с моей же месаги файло..

[skif58]

Сообщение от XYZ Yura, в ACAD-2007 ни чего не вижу. Стрелка- невидимка.

В восьмом видно... - просто она в безлимитном космосе: кликнуть пару раз колесом.
Обалденная стрелка! Шесть отрезков и штриховка...

[Jerald]

У меня седьмой, и всё прекрасно видно!

[Елпанов Евгений]

Сообщение от Profan Вот программа изменения ширины произвольного сегмента полилинии: Код: [Выделить все] ;**************** lw_width.lsp ********************************* ; Изменение начальной и конечной ширины ; произвольного сегмента полилинии. ; Автор Евгений Елпанов. (defun C:LW_WIDTH(/ ENDWIDTH GR LW PAR STARTWIDTH) (vl-load-com) (vla-StartUndoMark(vla-get-activedocument(vlax-get-acad-object))) (setq lw(entsel "\n Выберите нужный сегмент в полилинии. ")) (if(and lw(=(cdr(assoc 0(entget(car lw)))) "LWPOLYLINE")) (progn(setq par(vlax-curve-getParamAtPoint(car lw) (vlax-curve-getClosestPointTo(car lw)(cadr lw))) lw(vlax-ename->vla-object(car lw))) (princ "\n Задайте ширину начала сегмента.\t") (vla-GetWidth lw(fix par) 'StartWidth 'EndWidth) (while(and(setq gr(grread 5))(=(car gr) 5)) (vla-SetWidth lw(fix par) (setq StartWidth(*(distance(cadr gr) (vlax-curve-getClosestPointTo lw(cadr gr))) 2.))EndWidth)) (if(=(car gr) 2)(vla-SetWidth lw(fix par) (setq StartWidth(atof(strcat(princ(vl-list->string(cdr gr))) (getstring)))) EndWidth)) (princ "\n Задайте ширину конца сегмента.\t") (while(and(setq gr(grread 5))(=(car gr) 5)) (vla-SetWidth lw(fix par) StartWidth(*(distance(cadr gr) (vlax-curve-getClosestPointTo lw(cadr gr))) 2.))) (if(=(car gr) 2)(vla-SetWidth lw(fix par) StartWidth (atof(strcat(princ(vl-list->string(cdr gr)))(getstring)))))) (princ "\n Ничего не выбрано или объект не полилиния.\t")) (vla-EndUndoMark(vla-get-activedocument(vlax-get-acad-object))) (princ) ) Почему-то VVA не захотел включить ее в свой пакет программ для работы с полилинией.

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

[VVA]

>Profan Я не не захотел, а просто забыл. . Сейчас прочитал и вспомнил. Код в загашник уже скопирвал. Осталось иконку придумать. Как заметил Евгений, шириной уже давно не пользуюсь в силу различных причин (основная - пространсто листа и блоки с разными масштабными коэффициентами). Слава богу, своих пользователей отучил. Если обучаю новых, то просто говорю, что полилиния может иметь ширину, но не у нас. Даже сейчас в новой редакции PL-DIV буду при добавлении новых точек пересчитывать и ширину, чего раньше не делал по идейным соображениям. А так больше претензий к ширине не имею . А так стрелки черчу _SOLID (еще со времен 10 Автокада). Кстати, если "разобрать" автокадовский размер со стрелками, там тоже фигура (_solid).

[IIIypuk]

Вставляете leader, пишите внем текс. Выходите из режима теста. Появляется стрелка с "полочкой" и текстом на ней =) Выделяем только текст и удаляем (не выделяя стрелки). "Полочка" пропадает и остается только стрелка со всеми нужными нам настройками (тип линии, стрелки, масштаб и т.д.). Всё элементарное - просто.

[Krieger]

IIIypuk
Пост №12

[IIIypuk]

Сообщение от Krieger IIIypuk Пост №12

Ну, во-первых, зачем делать еще одну кнопку, если можно обойтись без неё.
Во-вторых, я объяснил так, как поймет и запомнит любой (!) пользователь. А что делать с постом 12 понятно далеко не каждому.

[Yura]

А polar разве на leader-e работает? У меня че-то все кривое выходит... Аль не прав я в чем?

[Krieger]

IIIypuk
Тогда еще проще:
le (или "_qleader") -> пробел -> 1-я точка -> 2-точка -> esc
т.е. писать, а потом удалять текст необязательно.

Yura
У меня polar работает. Более того, углы можно настроить персонально для быстрого лидера "_qleader" в опции команды Settings.

[Yura]

Krieger,
Пардон, точно polar работает!!! Значит действительно, че-то я делал не так...