Аналог команды AutoCad "Команда:_3dalign" на VBA

Автор Тема: Аналог команды AutoCad "Команда:_3dalign" на VBA  (Прочитано 3679 раз)

0 Пользователей и 1 Гость просматривают эту тему.

Тема содержит сообщение с Решением. Нажмите здесь чтобы посмотреть его.

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Доброго времени суток!
Подскажите аналог команды AutoCad "Команда:_3dalign" на VBA ?
Примеры, ссылки приветствуются!

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8567
  • Карма: 1045
  • Рыцарь ObjectARX
  • Skype: rivilis
Средствами ObjectARX это делается так:
Код - C++ [Выбрать]
  1. static void ALIGN3(void)
  2. {
  3.   ads_name en; ads_point p1; ads_point p2;
  4.   if (acedEntSel(_T("\nВыберите объект: "),en,p1)         != RTNORM ||
  5.     acedGetPoint(NULL,_T("\nПервая исходная точка: "),p1) != RTNORM ||
  6.     acedGetPoint(p1,  _T("\nПервая целевая точка: "), p2) != RTNORM) return;
  7.   acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false);
  8.   AcGePoint3d pSrcPt1(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt1(p2[X],p2[Y],p2[Z]);
  9.   if (acedGetPoint(NULL,_T("\nВторая исходная точка: "),p1) != RTNORM ||
  10.       acedGetPoint(p1,  _T("\nВторая целевая точка: "), p2) != RTNORM) return;
  11.   acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false);
  12.   AcGePoint3d pSrcPt2(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt2(p2[X],p2[Y],p2[Z]);
  13.   if (acedGetPoint(NULL,_T("\nТретья исходная точка: "),p1) != RTNORM ||
  14.       acedGetPoint(p1,  _T("\nТретья целевая точка: "), p2) != RTNORM) return;
  15.   acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false);
  16.   AcGePoint3d pSrcPt3(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt3(p2[X],p2[Y],p2[Z]);
  17.   AcGeVector3d v1(pSrcPt1  - pSrcPt2);
  18.   AcGeVector3d v2(pDestPt1 - pDestPt2);
  19.   AcDbObjectId id; acdbGetObjectId(id,en);
  20.   AcDbEntityPointer pEnt(id,AcDb::kForWrite);
  21.   if (pEnt.openStatus() != Acad::eOk) return;
  22.   AcGeMatrix3d mMatScale, mMatRot, mMatTrans;
  23.   mMatScale.setToScaling(v2.length()/v1.length(),pSrcPt1);
  24.   pEnt->transformBy(mMatScale); // Масштабируем
  25.   AcGePlane pl1(pSrcPt1,pSrcPt1-pSrcPt2,pSrcPt1-pSrcPt3),
  26.             pl2(pDestPt1,pDestPt1-pDestPt2,pDestPt1-pDestPt3);
  27.   AcGePoint3d pOrig1,pOrig2; AcGeVector3d vX1,vX2,vY1,vY2,vZ1,vZ2;
  28.   pl1.getCoordSystem(pOrig1,vX1,vY1); pl2.getCoordSystem(pOrig2,vX2,vY2);
  29.   mMatTrans.setToAlignCoordSys(pSrcPt1,vX1,vY1,pl1.normal(),pDestPt1,vX2,vY2,pl2.normal());
  30.   pEnt->transformBy(mMatTrans); // Остальные преобразования
  31.   pEnt->close();
  32. }
На VBA не пишу. Думаю, что для тебя проще будет подготовить данные (точки и имя  примитива) и запустить команду _3dalign через SendCommand. Ну или придётся переписывать работу с матрицами с ObjectARX на VBA.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Ок, спасибо.
По получению результата отпишусь.

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Подготовил следующий код...
Код - Visual Basic [Выбрать]
  1. Sub ALIGN_3D()
  2. 'Создаем конус с целью его выравнивания
  3. Dim Object_Cone As AcadObject
  4. Dim Point_Center(0 To 2) As Double
  5.     Point_Center(0) = x0: Point_Center(1) = y0: Point_Center(2) = z0
  6. Set Object_Cone = ThisDrawing.ModelSpace.AddCone(Point_Center, 5#, 20#) '  создан конус
  7.  
  8. 'Создаем линию с целью  выравнивания по ней конуса
  9. Dim Object_line As AcadObject
  10. Dim Point_start(0 To 2) As Double
  11. Dim Point_end(0 To 2) As Double
  12.     Point_start(0) = 5: Point_start(1) = 5: Point_start(2) = 5
  13.     Point_end(0) = 25: Point_start(1) = 25: Point_start(2) = 25
  14. Set Object_line = ThisDrawing.ModelSpace.AddLine(Point_start, Point_end) ' создана линия
  15. end sub
  16.  
  Далее нам нужно через SendCommand запустить "Команда:_3dalign"
А это повлечет за собой выбор объекта в ручную, как собственно и
Код - Visual Basic [Выбрать]
  1. ThisDrawing.Utility.GetEntity obj, pt, "Выберите примитив: "
  2.  

Вот от сюда пожалуйста поподробнее....
Как программно загнать в "Команда:_3dalign" Object_Cone и координаты точек выранивания.
Пример если можно.

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8567
  • Карма: 1045
  • Рыцарь ObjectARX
  • Skype: rivilis
1. Получаешь метку Object_Cone (я так понимаю, что именно его ты и собираешься выравнивать): Object_Cone.Handle
2. Линия для выравнивания тебе не нужна - нужны просто точки.
3. Формируешь строку вида '(command "_3dalign" (handent "' + Object_Cone.Handle + '") "" x01,y01,z01 x11,y11,z11 x21,y21,z21 ...)" '
где x,y,z соответствующие координаты точек (превращенные в строки), как в команде _3DALIGN
4. Эту строку в SendCommand
Пробуй.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Код для метки я написал...
Код - Visual Basic [Выбрать]
  1. Dim id_code As String
  2. id_code = Object_Cone.Handle ' определяем уникальный ид созданого конуса для последующего обращения к нему
  3. Dim object_id As AcadObject
  4. Set object_id = ThisDrawing.HandleToObject(id_code)
Потом засомневался.....
А нужен ли он?
Ведь объектная переменная Object_Cone еще жива.
Поправьте если ошибаюсь.
Про линиию и точки само собой, просто с линией нагляднее....
Пробую, отпишусь.
« Последнее редактирование: 12-08-2015, 20:17:42 от Vladimir »

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8567
  • Карма: 1045
  • Рыцарь ObjectARX
  • Skype: rivilis
А нужен ли он?
Ведь обектная переменная Object_Cone еще жива.
Ты в команду передаешь не переменную, а строковое значение её метки - ни lisp, ни команда не умеют оперировать переменными. Так что можешь передавать или Object_Cone.Handle или id_code. Разницы нет.
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Заплутал в "кавычках"
Строчку
3. Формируешь строку вида '(command "_3dalign" (handent "' + Object_Cone.Handle + '") "" x01,y01,z01 x11,y11,z11 x21,y21,z21 ...)" '
Дайте в строковом формате, какой она должна быть.
Я ее сам склею.

Отмечено как Решение Vladimir 12-08-2015, 21:14:34

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8567
  • Карма: 1045
  • Рыцарь ObjectARX
  • Skype: rivilis
Что-то такое:
Код - Visual Basic [Выбрать]
  1. Sub ALIGN_3D()
  2. 'Создаем конус с целью его выравнивания
  3. Dim Object_Cone As AcadObject
  4. Dim Point_Center(0 To 2) As Double
  5.     Point_Center(0) = 0: Point_Center(1) = 0: Point_Center(2) = 0
  6. Set Object_Cone = ThisDrawing.ModelSpace.AddCone(Point_Center, 5#, 20#) '  создан конус
  7.  
  8. Dim P0(0 To 2) As Double: P0(0) = Point_Center(0): P0(1) = Point_Center(1): P0(2) = Point_Center(2)
  9. Dim P1(0 To 2) As Double: P1(0) = Point_Center(0): P1(1) = Point_Center(1): P1(2) = Point_Center(2) + 20
  10. Dim P2(0 To 2) As Double: P2(0) = 0: P2(1) = 690: P2(2) = 0
  11. Dim P3(0 To 2) As Double: P3(0) = 1010: P3(1) = 1050: P3(2) = 0
  12.  
  13. Dim cmd As String
  14. cmd = "(command ""_3DALIGN"" (handent """ + Object_Cone.Handle + """) """" "
  15. cmd = cmd + PointToString(P0) + " "
  16. cmd = cmd + PointToString(P1) + " "
  17. cmd = cmd + """_C"" "
  18. cmd = cmd + PointToString(P2) + " "
  19. cmd = cmd + PointToString(P3)
  20. cmd = cmd + """_X"""
  21. cmd = cmd + ") "
  22. MsgBox cmd
  23. ThisDrawing.SendCommand cmd
  24.  
  25. End Sub
  26.  
  27. Function PointToString(p() As Double) As String
  28.   PointToString = """" + CStr(p(0)) + "," + CStr(p(1)) + "," + CStr(p(2)) + """"
  29. End Function
  30.  
Надеюсь дальше сам доведёшь до ума?
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Спасибо.
Тут уже все доведено....

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Доброго дня!
Александр, в решении закралась ошибка....
При получении координаты точки через функцию GetPoint, в случае наличия в ней десятичных значений, возвращает координату с разделителем ","
А команда _3dalign требует разделитель "."
Пробуй пример....

Код - Visual Basic [Выбрать]
  1. Sub ALIGN_3D_error()
  2.  
  3. 'Создаем конус с целью его выравнивания
  4.  
  5. Dim Object_Cone As AcadObject
  6. Dim Point_Center(0 To 2) As Double
  7.  
  8.     Point_Center(0) = 0: Point_Center(1) = 0: Point_Center(2) = 0
  9.  
  10. Set Object_Cone = ThisDrawing.ModelSpace.AddCone(Point_Center, 5#, 20#) '  создан конус
  11.  
  12. 'создаем две линии для проверки
  13. Dim line_1 As AcadLine 'с целыми числами в координатах концов отрезков
  14. Dim line_2 As AcadLine 'с наличием десятичных чисел в координатах концов отрезков
  15.  
  16. Dim pt1(0 To 2) As Double: pt1(0) = 100: pt1(1) = 0: pt1(2) = 0:
  17. Dim pt2(0 To 2) As Double: pt2(0) = 100: pt2(1) = 0: pt2(2) = 100:
  18. Set line_1 = ThisDrawing.ModelSpace.AddLine(pt1, pt2) '
  19.  
  20. Dim pt21(0 To 2) As Double: pt21(0) = -100: pt21(1) = 0: pt21(2) = 0:
  21. Dim pt22(0 To 2) As Double: pt22(0) = -100: pt22(1) = 0: pt22(2) = 99.123: ' вот эта подлая координата
  22. Set line_2 = ThisDrawing.ModelSpace.AddLine(pt21, pt22) '
  23. '
  24.  
  25. 'передаем координаты конуса
  26. Dim P0(0 To 2) As Double: P0(0) = Point_Center(0): P0(1) = Point_Center(1): P0(2) = Point_Center(2)
  27. Dim P1(0 To 2) As Double: P1(0) = Point_Center(0): P1(1) = Point_Center(1): P1(2) = Point_Center(2) + 10
  28.  
  29.  
  30. Dim P2 As Variant
  31. Dim P3 As Variant
  32. P2 = ThisDrawing.Utility.GetPoint(, "Укажите координаты начала линии: ")
  33. P3 = ThisDrawing.Utility.GetPoint(, "Укажите координаты конца линии: ")
  34.  
  35. Dim P22(0 To 2) As Double: P22(0) = P2(0): P22(1) = P2(1): P22(2) = P2(2)
  36. Dim P32(0 To 2) As Double: P32(0) = P3(0): P32(1) = P3(1): P32(2) = P3(2)
  37.  
  38.  
  39. Dim cmd As String
  40.  
  41. cmd = "(command ""_3DALIGN"" (handent """ + Object_Cone.Handle + """) """" "
  42.  
  43. cmd = cmd + PointToString(P1) + " "
  44.  
  45. cmd = cmd + PointToString(P0) + " "
  46.  
  47. cmd = cmd + """_C"" "
  48.  
  49. cmd = cmd + PointToString(P22) + " "
  50.  
  51. cmd = cmd + PointToString(P32)
  52.  
  53. cmd = cmd + """_X"""
  54.  
  55. cmd = cmd + ") "
  56.  
  57. MsgBox cmd
  58.  
  59. ThisDrawing.SendCommand cmd
  60.  
  61.  
  62.  
  63. End Sub
  64.  
  65.  
  66.  
  67. Function PointToString(p() As Double) As String
  68.  
  69.   PointToString = """" + CStr(p(0)) + "," + CStr(p(1)) + "," + CStr(p(2)) + """"
  70.  
  71. End Function
  72.  
Конечно, можно в 34 строке создать обработчик с поиском и заменой "," -->"."
Будет ли это единственно правильным и не тривиальным решением?

Оффлайн Александр Ривилис

  • Administrator
  • *****
  • Сообщений: 8567
  • Карма: 1045
  • Рыцарь ObjectARX
  • Skype: rivilis
Конечно, можно в 34 строке создать обработчик с поиском и заменой "," -->"."
Будет ли это единственно правильным и не тривиальным решением?
В 34 строке кода у тебя еще нет строк с координатами. Всё нужно сделать тривиальнее. Нужно лишь заменить функцию PointToString на эту:
Код - Visual Basic [Выбрать]
  1. Function PointToString(p() As Double) As String
  2.      
  3.       PointToString = """" + _
  4.         Replace(CStr(p(0)), ",", ".") + "," + _
  5.         Replace(CStr(p(1)), ",", ".") + "," + _
  6.         Replace(CStr(p(2)), ",", ".") + """"
  7.      
  8. End Function
Не забывайте про правильное Форматирование кода на форуме
Создание и добавление Autodesk Screencast видео в сообщение на форуме
Если Вы задали вопрос и на форуме появился правильный ответ, то не забудьте про кнопку Решение

Оффлайн VladimirАвтор темы

  • ADN OPEN
  • Сообщений: 36
  • Карма: 0
Ок, спасибо!
Это красивое решение.