[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 ни чего не вижу. Стрелка- невидимка.