Проникающая гидроизоляция бетона
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как с помощью VBA построить поверхность по трём поперечникам?

Как с помощью VBA построить поверхность по трём поперечникам?

Ответ
Поиск в этой теме
Непрочитано 26.08.2011, 14:10 #1
Как с помощью VBA построить поверхность по трём поперечникам?
МишаИнженер
 
Регистрация: 14.12.2008
Сообщений: 662

Помогите построить по трём поперечникам поверхность с помощью функций VBA.
Обычными командами AutoCAD эта поверхность строится функцией Loft или ПОСЕЧЕНИЯМ: выделяются подряд 3 идущие полилинии например и они автоматически соединяются поверхностью, которая в свойствах называется ПОВЕРХНОСТЬ (по сечениям).
Как такую поверхность построить методами VBA?
Поискал похожие методы и не нашёл. Может плохо искал?
Просмотров: 2981
 
Непрочитано 26.08.2011, 15:00
1 | #2
hwd

C, C++, C#
 
Регистрация: 07.10.2009
С-Пб.
Сообщений: 2,762
Отправить сообщение для hwd с помощью Skype™


Create Meshes
Код:
[Выделить все]
Sub Create3DMesh()
    Dim meshObj As AcadPolygonMesh
    Dim mSize, nSize, Count As Integer
 
    ' create the matrix of points
    Dim points(0 To 47) As Double
    points(0) = 0: points(1) = 0: points(2) = 0
    points(3) = 2: points(4) = 0: points(5) = 1
    points(6) = 4: points(7) = 0: points(8) = 0
    points(9) = 6: points(10) = 0: points(11) = 1
    points(12) = 0: points(13) = 2: points(14) = 0
    points(15) = 2: points(16) = 2: points(17) = 1
    points(18) = 4: points(19) = 2: points(20) = 0
    points(21) = 6: points(22) = 2: points(23) = 1
    points(24) = 0: points(25) = 4: points(26) = 0
    points(27) = 2: points(28) = 4: points(29) = 1
    points(30) = 4: points(31) = 4: points(32) = 0
    points(33) = 6: points(34) = 4: points(35) = 0
    points(36) = 0: points(37) = 6: points(38) = 0
    points(39) = 2: points(40) = 6: points(41) = 1
    points(42) = 4: points(43) = 6: points(44) = 0
    points(45) = 6: points(46) = 6: points(47) = 0
 
    mSize = 4: nSize = 4
 
    ' creates a 3Dmesh in model space
    Set meshObj = ThisDrawing.ModelSpace. _
                      Add3DMesh(mSize, nSize, points)
 
    ' Change the viewing direction of the viewport
    ' to better see the cylinder
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1
    NewDirection(1) = -1
    NewDirection(2) = 1
    ThisDrawing.ActiveViewport.direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
 
    ZoomAll
End Sub
Create Polyface Meshes
Код:
[Выделить все]
Sub CreatePolyfaceMesh()
    'Define the mesh vertices
    Dim vertex(0 To 17) As Double
    vertex(0) = 4: vertex(1) = 7: vertex(2) = 0
    vertex(3) = 5: vertex(4) = 7: vertex(5) = 0
    vertex(6) = 6: vertex(7) = 7: vertex(8) = 0
    vertex(9) = 4: vertex(10) = 6: vertex(11) = 0
    vertex(12) = 5: vertex(13) = 6: vertex(14) = 0
    vertex(15) = 6: vertex(16) = 6: vertex(17) = 1
 
    ' Define the face list
    Dim FaceList(0 To 7) As Integer
    FaceList(0) = 1
    FaceList(1) = 2
    FaceList(2) = 5
    FaceList(3) = 4
    FaceList(4) = 2
    FaceList(5) = 3
    FaceList(6) = 6
    FaceList(7) = 5
 
    ' Create the polyface mesh
    Dim polyfaceMeshObj As AcadPolyfaceMesh
    Set polyfaceMeshObj = ThisDrawing.ModelSpace. _
                              AddPolyfaceMesh(vertex, FaceList)
 
    ' Change the viewing direction of the viewport to
    ' better see the polyface mesh
    Dim NewDirection(0 To 2) As Double
    NewDirection(0) = -1
    NewDirection(1) = -1
    NewDirection(2) = 1
    ThisDrawing.ActiveViewport.direction = NewDirection
    ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport
 
    ZoomAll
End Sub
Create Solids
Код:
[Выделить все]
Sub CreateWedge()
    Dim wedgeObj As Acad3DSolid
    Dim center(0 To 2) As Double
    Dim length As Double
    Dim width As Double
    Dim height As Double
 
    ' Define the wedge
    center(0) = 5#: center(1) = 5#: center(2) = 0
    length = 10#: width = 15#: height = 20#
 
    ' Create the wedge in model space
    Set wedgeObj = ThisDrawing.ModelSpace. _
                       AddWedge(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
 
    ZoomAll
End Sub
__________________
Надеюсь, ты не социальный овощ? Это определяется делами! :welcome:
hwd вне форума  
 
Автор темы   Непрочитано 06.09.2011, 20:40
#3
МишаИнженер


 
Регистрация: 14.12.2008
Сообщений: 662


Спасибо hwd!
Применил метод для Polyface Mesh
Но почему не все треугольники поверхности отображаются на экране?
МишаИнженер вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Как с помощью VBA построить поверхность по трём поперечникам?

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Можно ли с помощью VBA (или Lisp) редактировать spdsNotePosition (выноску СПДС)? AlexV LISP 15 07.11.2017 15:55
как с помощью vba создать несколько цифр и вставить их в чертёж... vasyavip Программирование 1 02.04.2009 23:05
как с помощью vba начертить линию vasyavip Программирование 77 09.10.2008 23:17
Можно-ли с помощью профилей создать 3D поверхность? Гиорги AutoCAD 11 24.05.2007 10:07
Подскажите как построить кривую с помощью команды SPLiNE, к boban Программирование 1 02.11.2003 19:58