[alxbond007]

Уважаемые форумчане!

Есть следующая задача:
Разработать в АвтоКАДе программу на ЛИСПе или Макрос, который превращает двухмерный прямоугольник в 3D комнату с дыркой для окна и дверью.

Т.е. должно выполняться поднятие стен, прорезание окна и двери, добавление пола и потолка. Ну, а если еще и текстуры наложить, то это вообще круть!

Помогите, кто чем может! Заранее спасибо!

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

Ни себе фига задачка... Высоту стен кто будет определять и как? А расположение окна (имеется в виду стена и высота от отметки чистого пола)? А размер окна? А то же самое, но для двери?
А где взять толщины стен? А их состав?
Может, проще будет взять AutoCAD Architecture или Revit?

[alxbond007]

Высота стен, материал, размеры окон и дверей и т.д. - задаются как константы (параметры).

Мне важен принцип: какая программа выполнит те задачи, которые я описал? О реалистичности полученной комнаты пока речь не идет.

[Cosinus]

Вот кусок кода. Рисуешь контур стены полилинией. Задаешь количество разбиений стены по высоте, шаг разбиений, все группируется в блок, которому задаешь имя. Стены рисуются 3DFace.
Вообще-то это сделано для Лиры, адаптируй под себя

Код:

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

Public Sub StrechPlateZ()

    Dim faceObj As Acad3DFace
'    Dim pln As AcadPolyline

    Dim returnObj As AcadObject
    Dim basePnt As Variant
    Dim retCoord As Variant
    
    Dim n As Integer
    Dim k As Integer
    Dim d As Double
    Dim blockObj As AcadBlock
    Dim Name As String
    
    
    On Error Resume Next
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Выбери полилинию"
    
    If Err <> 0 Then
        Err.Clear
        MsgBox "Program ended.", , "GetEntity Example"
        Exit Sub
    Else
        If returnObj.EntityName <> "AcDbPolyline" Then
            Exit Sub
        Else
            retCoord = returnObj.Coordinates
        End If
    End If
    
    k = ThisDrawing.Utility.GetInteger("Количество: ")
    d = ThisDrawing.Utility.GetReal("Шаг: ")
    name = ThisDrawing.Utility.GetString(False, "Введи имя блока: ")
  
    
'    Dim bexist As Boolean
'    bexist = BlockExist(Name)
    
    
    Set blockObj = ThisDrawing.Blocks.Add(basePnt, Name)
    
    Dim point1(0 To 2) As Double
    Dim point2(0 To 2) As Double
    Dim point3(0 To 2) As Double
    Dim point4(0 To 2) As Double
    
    For I = LBound(retCoord) To UBound(retCoord) 
        For j = 0 To k - 1 
            point1(0) = retCoord(I)
            point1(1) = retCoord(I + 1)
            point1(2) = basePnt(2) + j * d ' Z
            
            point2(0) = retCoord(I + 2)
            point2(1) = retCoord(I + 3)
            point2(2) = basePnt(2) + j * d
            
            point3(0) = retCoord(I + 2)
            point3(1) = retCoord(I + 3)
            point3(2) = basePnt(2) + (j + 1) * d
            
            point4(0) = retCoord(I)
            point4(1) = retCoord(I + 1)
            point4(2) = basePnt(2) + (j + 1) * d
            
            Set faceObj = blockObj.Add3DFace(point1, point2, point3, point4) '
        
        Next j
        I = I + 1
    Next
    
    ThisDrawing.ModelSpace.InsertBlock basePnt, Name, 1, 1, 1, 0
End Sub

[alxbond007]

Это VBA?

[Cosinus]

, лиспа не знаю.