[Тензор]

Здравствуйте. Имеется линия которая рисуется из центра окружности в точку пересечения этой окружности с дугой(линия получается постоянной длины). Далее требуется удлинить эту линию на определенное расстояние програмно. Вот с этим то и возникла проблема может кто-нибудь поможет примером или советом?

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

Вариант 1. Геометрически вычислить координаты второй точки и назначить их отрезку.
Вариант 2. Использовать SendCommand (подсказка: команда _lengthen)

[Тензор]

Спасибо за наводку. Но...написал следующее:
acadDoc.SendCommand "_lengthen" & vbCr & "DELta" & vbCr & b & vbCr
(b-переменная содержащая число на которое надо удлинить линию)
в командно строке акада проходят все шаги и доходит до выбора объекта вот тут то и возникает вопрос а как указать, что нужна конкретная линия?

[AlexV]

Мышью?

[Тензор]

надо чтоб програмно выбирал

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

Без запущенного acad'a:

Код:

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

Set objLine = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
ThisDrawing.SendCommand "_.lengthen" & vbCr & "_de" & vbCr & b & _
vbCr & "(handent " & Chr(34) & objLine.Handle & Chr(34) & ")" & vbCr

Но, по-моему, на результат будет оказывать влияние, с какой стороны "ткнешь" на объект. Так что я бы задумывался о программном вычислении координат...

[AlexV]

Сообщение от Кулик Алексей aka kpblc Без запущенного acad'a: Код: [Выделить все] Set objLine = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) ThisDrawing.SendCommand "_.lengthen" & vbCr & "_de" & vbCr & b & _ vbCr & "(handent " & Chr(34) & objLine.Handle & Chr(34) & ")" & vbCr Но, по-моему, на результат будет оказывать влияние, с какой стороны "ткнешь" на объект. Так что я бы задумывался о программном вычислении координат...

Интересно, а смысл создавать линию и потом сразу ее удлинять? Создать сразу нужной длины...

Если "надо чтоб программно выбирал", зачем тогда SendCommand? Создал предварительно набор объектов - Line, которые должны удлиняться, и по каждой линии - используя геометрию - найти новую конечную точку, создать новую линию, старую убить... Хотя вопрос, какая точка должна считаться начальной, какая конечной...

Хотя, блин, зарапортовался. Первое сообщение прочитать забыл.("линия рисуется из центра окружности в точку пересечения этой окружности с дугой"). То есть по #6 objLine уже есть, надо просто ее удлинить. А каким методом строится эта линия "...до пересечения...", можно посмотреть?

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

AlexV, а ты прочти мои посты. Я с самого начала говорил о программном вычислении и изменении объекта...

[Тензор]

А каким методом строится эта линия "...до пересечения...", можно посмотреть?

Код:

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

Dim intpoint As Variant
    intpoint = odjcir.IntersectWith(objarc, acExtendBoth)
    intpoint.ubound = 2
    start(0) = 813.9154
    start(1) = 289.4128
    start(2) = 0
    en(0) = intpoint(0)
    en(1) = intpoint(1)
    en(2) = 0
    Set lin1 = acadDoc.ModelSpace.AddLine(start, en)

[Тензор]

Ладно закрываем тему. решил последовать советам и сделал удлинение через вычисление точек. Всем спасибо.

[AlexV]

В контексте данной задачи что-то типа:

Код:

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

Dim pnt(0 To 2) As Double
pnt(0) =(b+ lin1.Length) * Cos(lin1.angle) + start(0)
pnt(1) = (b+ lin1.Length) * Sin(lin1.angle) + start(1)
pnt(2) = start(2)
Dim lineObj As AcadLine
Set lineObj = acadDoc.ModelSpace.AddLine(start, pnt)
lin1.delete

Однако, долго писал...

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

Код:

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

Option Explicit

Function CreateLines(objCircle As AcadCircle, objArc As AcadArc, _
  Optional dExtension As Double = 0) As Variant
Dim ptCircleCenter As Variant, ptInters As Variant
Dim objLine As AcadLine, objSpace As AcadBlock
Dim ptEnd As Variant, dAngle As Double
Dim res() As Object
  ptCircleCenter = objCircle.Center
  ptInters = objCircle.IntersectWith(objArc, acExtendNone)
  Set objSpace = ThisDrawing.ObjectIdToObject(objCircle.OwnerID)
  Select Case True
    Case UBound(ptInters) = 2
      dAngle = ThisDrawing.Utility.AngleFromXAxis(ptCircleCenter, ptInters)
      ptEnd = ThisDrawing.Utility.PolarPoint(ptCircleCenter, dAngle, objCircle.Radius + dExtension)
      Set objLine = objSpace.AddLine(ptCircleCenter, ptEnd)
      ReDim res(0)
      Set res(0) = objLine
    Case UBound(ptInters) = 5
      Dim ptTempInt1(2) As Double, ptTempInt2(2) As Double
      ptTempInt1(0) = ptInters(0): ptTempInt1(1) = ptInters(1): ptTempInt1(2) = ptInters(2)
      ptTempInt2(0) = ptInters(3): ptTempInt2(1) = ptInters(4): ptTempInt2(2) = ptInters(5)
      dAngle = ThisDrawing.Utility.AngleFromXAxis(ptCircleCenter, ptTempInt1)
      ptEnd = ThisDrawing.Utility.PolarPoint(ptCircleCenter, dAngle, objCircle.Radius + dExtension)
      Set objLine = objSpace.AddLine(ptCircleCenter, ptEnd)
      ReDim res(1)
      Set res(0) = objLine
      dAngle = ThisDrawing.Utility.AngleFromXAxis(ptCircleCenter, ptTempInt2)
      ptEnd = ThisDrawing.Utility.PolarPoint(ptCircleCenter, dAngle, objCircle.Radius + dExtension)
      Set objLine = objSpace.AddLine(ptCircleCenter, ptEnd)
      Set res(1) = objLine
  End Select
  CreateLines = res
End Function

Sub Test()
Dim objC As AcadEntity, objA As AcadEntity
Dim dExten As Double
  ThisDrawing.Utility.GetEntity objC, "Select a circle"
  ThisDrawing.Utility.GetEntity objA, "Select an arc"
  dExten = CDbl(ThisDrawing.Utility.GetReal("Enter Extension"))
  Call CreateLines(objC, objA, dExten)
End Sub

А я долго тестировал И все равно работает только в мировой системе координат и при "нормальных" значениях системных переменных типа USCXDIR, ANGDIR и тому подобное.

[AlexV]

А если так, то вроде от системы координат не зависит (lin1 уже существует как объект по #9)

Код:

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

...
Dim pnt(0 To 2) As Double, varPoint
varPoint = lin1.StartPoint
pnt(0) =(b+ lin1.Length) * Cos(lin1.angle) + varPoint(0)
pnt(1) = (b+ lin1.Length) * Sin(lin1.angle) +varPoint(1)
pnt(2) = varPoint(2)
Dim lineObj As AcadLine
Set lineObj = acadDoc.ModelSpace.AddLine(start, pnt)
lin1.delete
...

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

Напоминаю: в VBA работа, как правило, ведется в мировой системе координат.

[AlexV]

Я имею в виду, если пользователем выставлена СК отличная от мировой, то получение углов и координат с помощью ThisDrawing.Utility даст неверные результаты. А если получать их через свойства объекта, то все o'k.