[Mikka]

Доброго времени суток, мне ооочень нужно решить эту проблему:
есть прямая, и есть набор описания точек контура профиля. Контур чертится 3d полилинией.
Как повернуть полученную полилинию перпендикулярно прямой?

[serov]

Построй ось поворота и смотри справку в VBA вот пример оттуда:

Код:

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

Sub Example_Rotate3D()
    ' This example creates a box in model space.
    ' It then rotates the box about an axis.
        
    Dim boxObj As Acad3DSolid
    Dim length As Double, width As Double, height As Double
    Dim center(0 To 2) As Double
    
    ' Define the box
    center(0) = 5#: center(1) = 5#: center(2) = 0
    length = 5#: width = 7: height = 10#
    
    ' Create the box (3DSolid) object in model space
    Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
    
    ' Change the viewing direction of the viewport
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
    ThisDrawing.ActiveViewport.direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
    ThisDrawing.Regen True
        
    ' Define the rotation axis with two points
    Dim rotatePt1(0 To 2) As Double
    Dim rotatePt2(0 To 2) As Double
    Dim rotateAngle As Double
    
    rotatePt1(0) = -3: rotatePt1(1) = 4: rotatePt1(2) = 0
    rotatePt2(0) = -3: rotatePt2(1) = -4: rotatePt2(2) = 0
    rotateAngle = 30
    rotateAngle = rotateAngle * 3.141592 / 180#
    
    ' Draw a line between the two axis points so that it is visible.
    ' This is optional. It is not required for the rotation.
    Dim axisLine As AcadLine
    Set axisLine = ThisDrawing.ModelSpace.AddLine(rotatePt1, rotatePt2)
    axisLine.Update
    MsgBox "Rotate the box 30 degrees about the axis shown.", , "Rotate3D Example"

    ' Rotate the box
    boxObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
    ThisDrawing.Regen True
    MsgBox "The box is rotated 30 degrees.", , "Rotate3D Example"
    
End Sub

[Mikka]

Дело в том, что в совей программе я рисую 2д полилинию, а затем поворачиваю и смещаю контри и ориентирую ее при помощи свойства Normal. Но все дело в том, что полилиния рисуется в текущей системе координат, и при повороте системы координат, она смещается не правильно...

Код:

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

Private Function CrtPrfRegion(ByVal VcNormal, ByVal p1, ByVal PrfAngle As Double, ByVal GlbAngle As Double, ByVal osnap As Long, ByVal dx As Double, ByVal dy As Double, mirx As Boolean) As AcadRegion

'private
' процедура рисует плоский контур профиля
' разворачивает его
' и возвращает регион готовый для выдавливания
    Dim VarProfArr                          ' массив точек
    Dim VarBglArr                           ' массив скруглений

    Dim profArrCnt      As Long             ' кол-во эл. массива точек
    Dim profBglCnt      As Long             ' кол-во эл. массива скруглений
    Dim Tcns            As Double           ' толщина профиля
    Dim i               As Long             ' счетчик цикла
    Dim TmpDbl          As Double           ' временные переменные
    Dim TmpLng          As Long
    Dim tmpLng2         As Long
    Dim tmpVar
    Dim DblArrProf()    As Double           ' массив типа double с координатами вершин профиля
    Dim ObjSpc          As AcadBlock        ' текущее пространство (лист или модель)

    Dim tmpPlineObj     As AcadLWPolyline   ' временная полилиния
    Dim outPlineObj     As AcadLWPolyline   ' полилиния, описывающая объект
    Dim inPlineObj      As AcadLWPolyline   ' полилиния, внутренняя, для труб и им подобных объектов
    Dim RegEnt(0)       As AcadEntity
    Dim OutRegionObj    As AcadRegion       ' основной регион
    Dim inRegionObj     As AcadRegion       ' Внутренний регион

    On Error GoTo Err_Control

        'VcNormal(0) = VcNormal(0)

        Call ObjBase.GetCurPointsArr(VarProfArr, profArrCnt)
        Call ObjBase.GetCurBulgeArr(VarBglArr, profBglCnt)
        Tcns = ObjBase.GetCurTicns
        ' копируем из массива variant в массив типа double
        ReDim DblArrProf(profArrCnt - 1)

        ' не зеркальный
         For i = 0 To profArrCnt - 1
             DblArrProf(i) = CDbl(VarProfArr(i))
         Next i

        ' узнаем текущее пространство листа
        Set ObjSpc = ObjUtlt.DrwGetSpase()
        ' создаем легкий объект polyline в пространстве модели
        Set tmpPlineObj = ObjSpc.AddLightWeightPolyline(DblArrProf)
        ' замыкаем полилинию на всякий пожарный
        tmpPlineObj.Closed = True

        ' если профиль зеркальный, зеркалим
        If mirx = True Then
            Set outPlineObj = tmpPlineObj.Mirror(ObjUtlt.NuXYZToVrnt(0, -1, 0), ObjUtlt.NuXYZToVrnt(0, 1, 0))
            tmpPlineObj.Delete
        Else
            Set outPlineObj = tmpPlineObj
        End If

        ' поворачиваем контур заодно переводим градусы в радианы
        Call outPlineObj.Rotate(ObjUtlt.NuXYZToVrnt(0, 0, 0), PrfAngle * 3.14159265358979 / 180)
        ' смещаем профиль и задаем привязку
        tmpVar = fGetOsnapPoint(osnap)
        tmpVar(0) = dx + tmpVar(0)
        tmpVar(1) = dy + tmpVar(1)
      ' tmpVar = ThisDrawing.Utility.TranslateCoordinates(tmpVar, acUCS, acWorld, False)
        
        Call outPlineObj.Move(ObjUtlt.NuXYZToVrnt(0, 0, 0), ObjUtlt.NuXYZToVrnt(tmpVar(0), tmpVar(1), tmpVar(2)))
        ' поворачиваем контур еще раз (вокруг базовой линии, в не зависимости от смещения профиля)
        Call outPlineObj.Rotate(ObjUtlt.NuXYZToVrnt(0, 0, 0), GlbAngle * 3.14159265358979 / 180)
        ' задаем вектор направления
        'outPlineObj.normal = ThisDrawing.Utility.TranslateCoordinates(VcNormal, acUCS, acWorld, True)
        outPlineObj.normal = VcNormal

        If Tcns > 0 Then
        ' если толщина не равна 0, т.е. если профиль полый
            tmpVar = outPlineObj.Offset(-Tcns)            ' задаем внутренний конутр (результат полилиния)
            Set inPlineObj = tmpVar(0)
        End If

        'задаем скрукления
        If mirx = True Then tmpLng2 = -1 Else tmpLng2 = 1 ' если профиль зеркальный, то меняем знак скругления
        For i = 0 To profBglCnt - 1 Step 2
            TmpLng = CLng(VarBglArr(i))
            TmpDbl = CDbl(VarBglArr(i + 1)) * tmpLng2
            Call outPlineObj.SetBulge(TmpLng, TmpDbl)
            If Tcns > 0 Then Call inPlineObj.SetBulge(TmpLng, TmpDbl)
        Next i

        ' создаем регион
        Set RegEnt(0) = outPlineObj
        tmpVar = ObjSpc.AddRegion(RegEnt)
        Set OutRegionObj = tmpVar(0)                              ' явно определяем тим AcadRegion
        outPlineObj.Delete

        ' если существует внутренний контур
        If Tcns > 0 Then
            Set RegEnt(0) = inPlineObj
            tmpVar = ObjSpc.AddRegion(RegEnt)
            Set inRegionObj = tmpVar(0)                             ' явно определяем тип AcadRegion
            If mirx = False Then
                Call OutRegionObj.Boolean(acSubtraction, inRegionObj)   ' вычитаем из первого региона второй

            Else
                Call inRegionObj.Boolean(acSubtraction, OutRegionObj)
                Set OutRegionObj = inRegionObj ' ;) финт ушами
            End If

            inPlineObj.Delete    'удаляем регион
        End If

        ' перемещаем будущий профиль в нужную точку
        Call OutRegionObj.Move(ObjUtlt.NuXYZToVrnt(0, 0, 0), p1)
        Set CrtPrfRegion = OutRegionObj

        ' высвобождаем память
        'OutRegionObj = Nothing

Err_Control:


    Set ObjSpc = Nothing
    Set tmpPlineObj = Nothing
    Set outPlineObj = Nothing
    Set inPlineObj = Nothing
    Set RegEnt(0) = Nothing
    Set OutRegionObj = Nothing
    Set inRegionObj = Nothing

    ' обработчик ошибок
    If Err.Number <> 0 Then
        ObjErr.ErrOutLog ("clsProf3d_CrtPrfRegion_:_err_" + Str(Err.Number) + "_" + Err.Description)
        Set CrtPrfRegion = Nothing
        Err.Clear
    End If
End Function

[serov]

Mikka."Дело в том, что в совей программе я рисую 2д полилинию, а затем поворачиваю и смещаю контри и ориентирую ее при помощи свойства Normal. Но все дело в том, что полилиния рисуется в текущей системе координат, и при повороте системы координат, она смещается не правильно..."

А что мешает сначала сделать solid, а затем перенести и развернуть в нужном направлении.