ADN Club > VBA
Аналог команды AutoCad "Команда:_3dalign" на VBA
Vladimir:
Доброго времени суток!
Подскажите аналог команды AutoCad "Команда:_3dalign" на VBA ?
Примеры, ссылки приветствуются!
Александр Ривилис:
Средствами ObjectARX это делается так:
--- Код - C++ [Выбрать] ---static void ALIGN3(void){ ads_name en; ads_point p1; ads_point p2; if (acedEntSel(_T("\nВыберите объект: "),en,p1) != RTNORM || acedGetPoint(NULL,_T("\nПервая исходная точка: "),p1) != RTNORM || acedGetPoint(p1, _T("\nПервая целевая точка: "), p2) != RTNORM) return; acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false); AcGePoint3d pSrcPt1(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt1(p2[X],p2[Y],p2[Z]); if (acedGetPoint(NULL,_T("\nВторая исходная точка: "),p1) != RTNORM || acedGetPoint(p1, _T("\nВторая целевая точка: "), p2) != RTNORM) return; acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false); AcGePoint3d pSrcPt2(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt2(p2[X],p2[Y],p2[Z]); if (acedGetPoint(NULL,_T("\nТретья исходная точка: "),p1) != RTNORM || acedGetPoint(p1, _T("\nТретья целевая точка: "), p2) != RTNORM) return; acdbUcs2Wcs(p1,p1,false); acdbUcs2Wcs(p2,p2,false); AcGePoint3d pSrcPt3(p1[X],p1[Y],p1[Z]); AcGePoint3d pDestPt3(p2[X],p2[Y],p2[Z]); AcGeVector3d v1(pSrcPt1 - pSrcPt2); AcGeVector3d v2(pDestPt1 - pDestPt2); AcDbObjectId id; acdbGetObjectId(id,en); AcDbEntityPointer pEnt(id,AcDb::kForWrite); if (pEnt.openStatus() != Acad::eOk) return; AcGeMatrix3d mMatScale, mMatRot, mMatTrans; mMatScale.setToScaling(v2.length()/v1.length(),pSrcPt1); pEnt->transformBy(mMatScale); // Масштабируем AcGePlane pl1(pSrcPt1,pSrcPt1-pSrcPt2,pSrcPt1-pSrcPt3), pl2(pDestPt1,pDestPt1-pDestPt2,pDestPt1-pDestPt3); AcGePoint3d pOrig1,pOrig2; AcGeVector3d vX1,vX2,vY1,vY2,vZ1,vZ2; pl1.getCoordSystem(pOrig1,vX1,vY1); pl2.getCoordSystem(pOrig2,vX2,vY2); mMatTrans.setToAlignCoordSys(pSrcPt1,vX1,vY1,pl1.normal(),pDestPt1,vX2,vY2,pl2.normal()); pEnt->transformBy(mMatTrans); // Остальные преобразования pEnt->close();}На VBA не пишу. Думаю, что для тебя проще будет подготовить данные (точки и имя примитива) и запустить команду _3dalign через SendCommand. Ну или придётся переписывать работу с матрицами с ObjectARX на VBA.
Vladimir:
Ок, спасибо.
По получению результата отпишусь.
Vladimir:
Подготовил следующий код...
--- Код - Visual Basic [Выбрать] ---Sub ALIGN_3D()'Создаем конус с целью его выравнивания Dim Object_Cone As AcadObjectDim Point_Center(0 To 2) As Double Point_Center(0) = x0: Point_Center(1) = y0: Point_Center(2) = z0Set Object_Cone = ThisDrawing.ModelSpace.AddCone(Point_Center, 5#, 20#) ' создан конус 'Создаем линию с целью выравнивания по ней конусаDim Object_line As AcadObjectDim Point_start(0 To 2) As DoubleDim Point_end(0 To 2) As Double Point_start(0) = 5: Point_start(1) = 5: Point_start(2) = 5 Point_end(0) = 25: Point_start(1) = 25: Point_start(2) = 25Set Object_line = ThisDrawing.ModelSpace.AddLine(Point_start, Point_end) ' создана линияend sub Далее нам нужно через SendCommand запустить "Команда:_3dalign"
А это повлечет за собой выбор объекта в ручную, как собственно и
--- Код - Visual Basic [Выбрать] ---ThisDrawing.Utility.GetEntity obj, pt, "Выберите примитив: "
Вот от сюда пожалуйста поподробнее....
Как программно загнать в "Команда:_3dalign" Object_Cone и координаты точек выранивания.
Пример если можно.
Александр Ривилис:
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
Пробуй.
Навигация
Перейти к полной версии